From 43d780f36fd1b687fb1739c5a81c033624ab3fd6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 16 Sep 2014 14:18:42 +0200 Subject: Correct typo in an error message --- lib/asn1/src/asn1ct_check.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 240f1cbb16..ba89b67098 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -6710,7 +6710,7 @@ format_error({already_defined,Name,PrevLine}) -> [Name,PrevLine]); format_error({illegal_instance_of,Class}) -> io_lib:format("using INSTANCE OF on class '~s' is illegal, " - "because INSTANCE OF may only be used on the class TYPE-IDENTFIER", + "because INSTANCE OF may only be used on the class TYPE-IDENTIFIER", [Class]); format_error(illegal_octet_string_value) -> "expecting a bstring or an hstring as value for an OCTET STRING"; -- cgit v1.2.3 From fcabdd0426fdf194e652a995e8407daad80c130a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 16 Sep 2014 13:39:19 +0200 Subject: Use the #objectclass{} record instead of a tuple Don't build a record using the tuple syntax. It is bad in case we would want to change the record definition later. --- lib/asn1/src/asn1ct_check.erl | 71 +++++++++++++++++++++---------------------- 1 file changed, 34 insertions(+), 37 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index ba89b67098..a0253dba44 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -6971,44 +6971,41 @@ include_default_class1(Module,[{Name,TS}|Rest]) -> default_class_list(S) -> [{'TYPE-IDENTIFIER', - {objectclass, - [{fixedtypevaluefield, - id, - #type{tag=?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER), - def='OBJECT IDENTIFIER'}, - 'UNIQUE', - 'MANDATORY'}, - {typefield,'Type','MANDATORY'}], - {'WITH SYNTAX', - [{typefieldreference,'Type'}, - 'IDENTIFIED', - 'BY', - {valuefieldreference,id}]}}}, + #objectclass{fields=[{fixedtypevaluefield, + id, + #type{tag=?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER), + def='OBJECT IDENTIFIER'}, + 'UNIQUE', + 'MANDATORY'}, + {typefield,'Type','MANDATORY'}], + syntax={'WITH SYNTAX', + [{typefieldreference,'Type'}, + 'IDENTIFIED', + 'BY', + {valuefieldreference,id}]}}}, {'ABSTRACT-SYNTAX', - {objectclass, - [{fixedtypevaluefield, - id, - #type{tag=?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER), - def='OBJECT IDENTIFIER'}, - 'UNIQUE', - 'MANDATORY'}, - {typefield,'Type','MANDATORY'}, - {fixedtypevaluefield, - property, - #type{tag=?TAG_PRIMITIVE(?N_BIT_STRING), - def={'BIT STRING',[]}}, - undefined, - {'DEFAULT', - [0,1,0]}}], - {'WITH SYNTAX', - [{typefieldreference,'Type'}, - 'IDENTIFIED', - 'BY', - {valuefieldreference,id}, - ['HAS', - 'PROPERTY', - {valuefieldreference,property}]]}}}]. - + #objectclass{fields=[{fixedtypevaluefield, + id, + #type{tag=?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER), + def='OBJECT IDENTIFIER'}, + 'UNIQUE', + 'MANDATORY'}, + {typefield,'Type','MANDATORY'}, + {fixedtypevaluefield, + property, + #type{tag=?TAG_PRIMITIVE(?N_BIT_STRING), + def={'BIT STRING',[]}}, + undefined, + {'DEFAULT', + [0,1,0]}}], + syntax={'WITH SYNTAX', + [{typefieldreference,'Type'}, + 'IDENTIFIED', + 'BY', + {valuefieldreference,id}, + ['HAS', + 'PROPERTY', + {valuefieldreference,property}]]}}}]. new_reference_name(Name) -> case get(asn1_reference) of -- cgit v1.2.3 From cb6a006acbcec5aae7cf94f163f101fb6c9d439a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 1 Oct 2014 09:43:28 +0200 Subject: Check CLASS names for validity Class names must start with an uppercase letter and only contain uppercase letters, digits, or hyphens. The parser will not allow class names that don't start with an uppercase letter, so we don't have to check that. --- lib/asn1/src/asn1ct_check.erl | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index a0253dba44..f1437597ec 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -438,7 +438,15 @@ do_checkp(S0, Name, #ptypedef{typespec=TypeSpec}=Type0) -> checkc(S, Names) -> check_fold(S, Names, fun do_checkc/3). -do_checkc(S0, Name, Class0) -> +do_checkc(S, Name, Class) -> + case is_classname(Name) of + false -> + return_asn1_error(S, Class, {illegal_class_name,Name}); + true -> + do_checkc_1(S, Name, Class) + end. + +do_checkc_1(S0, Name, Class0) -> {Class1,ClassSpec} = case Class0 of #classdef{} -> @@ -456,6 +464,14 @@ do_checkc(S0, Name, Class0) -> {error,Reason} -> error({class,Reason,S}) end. + +%% is_classname(Atom) -> true|false. +is_classname(Name) when is_atom(Name) -> + lists:all(fun($-) -> true; + (D) when $0 =< D, D =< $9 -> true; + (UC) when $A =< UC, UC =< $Z -> true; + (_) -> false + end, atom_to_list(Name)). checko(S,[Name|Os],Acc,ExclO,ExclOS) -> ?dbg("Checking object ~p~n",[Name]), @@ -6708,6 +6724,8 @@ asn1_error(S, Item, Error) -> format_error({already_defined,Name,PrevLine}) -> io_lib:format("the name ~p has already been defined at line ~p", [Name,PrevLine]); +format_error({illegal_class_name,Class}) -> + io_lib:format("the class name '~s' is illegal (it must start with an uppercase letter and only contain uppercase letters, digits, or hyphens)", [Class]); format_error({illegal_instance_of,Class}) -> io_lib:format("using INSTANCE OF on class '~s' is illegal, " "because INSTANCE OF may only be used on the class TYPE-IDENTIFIER", -- cgit v1.2.3 From d73a835b66911935024019fd55089a1e0f7a81d2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 19 Sep 2014 15:42:40 +0200 Subject: Check INTEGER values better There is duplicated effort in that validate_integer() checks whether the integer value is valid, and then normalize_integer() does mostly the same work in order to convert the value to an integer. Eliminate the validate_integer() function and incorporate its checks into normalize_integer(). Also produce proper error messages. --- lib/asn1/src/asn1ct_check.erl | 98 +++++++++++++------------------------------ 1 file changed, 30 insertions(+), 68 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index f1437597ec..3f32a77c1d 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2123,7 +2123,6 @@ check_valuedef(#state{recordtopname=TopName}=S0, V0) -> #valuedef{name=Name,type=Vtype,value=Value,module=ModName} = V0, V = V0#valuedef{checked=true}, Def = Vtype#type.def, - Constr = Vtype#type.constraint, S1 = S0#state{type=Vtype,tname=Def,value=V0,vname=Name}, SVal = update_state(S1, ModName), case Def of @@ -2159,10 +2158,8 @@ check_valuedef(#state{recordtopname=TopName}=S0, V0) -> module=ModName}), V#valuedef{value=CheckedV#valuedef.value}; 'INTEGER' -> - ok = validate_integer(SVal, Value, [], Constr), V#valuedef{value=normalize_value(SVal, Vtype, Value, [])}; - {'INTEGER',NamedNumberList} -> - ok = validate_integer(SVal, Value, NamedNumberList, Constr), + {'INTEGER',_NamedNumberList} -> V#valuedef{value=normalize_value(SVal, Vtype, Value, [])}; #'SEQUENCE'{} -> {ok,SeqVal} = convert_external(SVal, Value), @@ -2185,50 +2182,6 @@ is_contextswitchtype(#typedef{name='CHARACTER STRING'}) -> is_contextswitchtype(_) -> false. -% validate_integer(S,{identifier,Pos,Id},NamedNumberList,Constr) -> -% case lists:keysearch(Id,1,NamedNumberList) of -% {value,_} -> ok; -% false -> error({value,"unknown NamedNumber",S}) -% end; -%% This case occurs when there is a valuereference -%% validate_integer(S=#state{mname=M}, -%% #'Externalvaluereference'{module=M,value=Id}=Ref, -validate_integer(S,#'Externalvaluereference'{value=Id}=Ref, - NamedNumberList,Constr) -> - case lists:keysearch(Id,1,NamedNumberList) of - {value,_} -> ok; - false -> validate_integer_ref(S,Ref,NamedNumberList,Constr) - %%error({value,"unknown NamedNumber",S}) - end; -validate_integer(S,Id,NamedNumberList,Constr) when is_atom(Id) -> - case lists:keysearch(Id,1,NamedNumberList) of - {value,_} -> ok; - false -> validate_integer_ref(S,Id,NamedNumberList,Constr) - %error({value,"unknown NamedNumber",S}) - end; -validate_integer(_S,Value,_NamedNumberList,Constr) when is_integer(Value) -> - check_integer_range(Value,Constr). - -validate_integer_ref(S,Id,_,_) when is_atom(Id) -> - error({value,"unknown integer referens",S}); -validate_integer_ref(S,Ref,NamedNumberList,Constr) -> - case get_referenced_type(S,Ref) of - {M,V} when is_record(V,valuedef) -> - NewS = update_state(S,M), - case check_value(NewS,V) of - #valuedef{type=#type{def='INTEGER'},value=Value} -> - validate_integer(NewS,Value,NamedNumberList,Constr); - _Err -> error({value,"unknown integer referens",S}) - end; - _ -> - error({value,"unknown integer referens",S}) - end. - - - -check_integer_range(_Int, Constr) when is_list(Constr) -> - ok. - %%------------ %% This can be removed when the old parser is removed %% The function removes 'space' atoms from the list @@ -2475,7 +2428,7 @@ normalize_value(S0, Type, {'DEFAULT',Value}, NameList) -> {'BOOLEAN',CType,_} -> normalize_boolean(S,Value,CType); {'INTEGER',CType,_} -> - normalize_integer(S,Value,CType); + normalize_integer(S0, Value, CType); {'BIT STRING',CType,_} -> normalize_bitstring(S,Value,CType); {'OCTET STRING',CType,_} -> @@ -2526,28 +2479,25 @@ normalize_boolean(S,Bool=#'Externalvaluereference'{},CType) -> normalize_boolean(_,Other,_) -> throw({error,{asn1,{'invalid default value',Other}}}). -normalize_integer(_S,Int,_) when is_integer(Int) -> +normalize_integer(_S, Int, _) when is_integer(Int) -> Int; -normalize_integer(_S,{Name,Int},_) when is_atom(Name),is_integer(Int) -> - Int; -normalize_integer(S,{Name,Int=#'Externalvaluereference'{}}, - Type) when is_atom(Name) -> - normalize_integer(S,Int,Type); -normalize_integer(S,Int=#'Externalvaluereference'{value=Name},Type) -> - case Type of - NNL when is_list(NNL) -> - case lists:keysearch(Name,1,NNL) of - {value,{Name,Val}} -> +normalize_integer(S, #'Externalvaluereference'{value=Name}=Ref, NNL) -> + case lists:keyfind(Name, 1, NNL) of + {Name,Val} -> + Val; + false -> + try get_referenced_value(S, Ref) of + Val when is_integer(Val) -> Val; - false -> - get_normalized_value(S,Int,Type, - fun normalize_integer/3,[]) - end; - _ -> - get_normalized_value(S,Int,Type,fun normalize_integer/3,[]) + _ -> + asn1_error(S, S#state.value, illegal_integer_value) + catch + throw:_ -> + asn1_error(S, S#state.value, illegal_integer_value) + end end; -normalize_integer(_,Int,_) -> - exit({'Unknown INTEGER value',Int}). +normalize_integer(#state{value=Val}=S, _, _) -> + asn1_error(S, Val, illegal_integer_value). %% normalize_bitstring(S, Value, Type) -> bitstring() %% Convert a literal value for a BIT STRING to an Erlang bit string. @@ -2926,6 +2876,8 @@ call_Func(S,Val,Type,Func,ArgList) -> get_canonic_type(S,Type,NameList) -> {InnerType,NewType,NewNameList} = case Type#type.def of + 'INTEGER'=Name -> + {Name,[],NameList}; Name when is_atom(Name) -> {Name,Type,NameList}; Ref when is_record(Ref,'Externaltypereference') -> @@ -4526,6 +4478,14 @@ check_reference(S,#'Externaltypereference'{pos=Pos,module=Emod,type=Name}) -> #'Externaltypereference'{pos=Pos,module=ModName,type=Name} end. +get_referenced_value(S, T) -> + case get_referenced_type(S, T) of + {ExtMod,#valuedef{value=#'Externalvaluereference'{}=Ref}} -> + get_referenced_value(update_state(S, ExtMod), Ref); + {_,#valuedef{value=Val}} -> + Val + end. + get_referenced_type(S, T) -> case do_get_referenced_type(S, T) of {_,#type{def=#'Externaltypereference'{}=ERef}} -> @@ -6730,6 +6690,8 @@ format_error({illegal_instance_of,Class}) -> io_lib:format("using INSTANCE OF on class '~s' is illegal, " "because INSTANCE OF may only be used on the class TYPE-IDENTIFIER", [Class]); +format_error(illegal_integer_value) -> + "expecting an integer value"; format_error(illegal_octet_string_value) -> "expecting a bstring or an hstring as value for an OCTET STRING"; format_error({illegal_typereference,Name}) -> -- cgit v1.2.3 From b92e491aa5bfbaefb0f938bbb245a580837cb8c8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 22 Sep 2014 14:21:55 +0200 Subject: Refactor code involving calls to get_fieldname_element/3 Refactor and clean up code. While at it, add error handling and test cases. (Also add test cases for the existing values in ValueTest.asn while we are it.) Add support for defining INTEGER constants by extracting fields from objects. Example: int-from-object INTEGER ::= object.&id When extracting values from objects in constraints, only one level of extraction would work. That is, the following would work: SomeName ::= INTEGER (object.&int) but not: SomeName ::= INTEGER (object.&obj.&int) --- lib/asn1/src/asn1ct_check.erl | 145 ++++++++++++++++++++++++------------------ 1 file changed, 82 insertions(+), 63 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 3f32a77c1d..fc15cfbb88 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -1160,10 +1160,14 @@ check_object_list(S,ClassRef,[ObjOrSet|Objs],Acc) -> {RefedMod,ObjName, #'Object'{def=Def}} = check_referenced_object(S,ObjRef), check_object_list(S,ClassRef,Objs,[{{RefedMod,ObjName},Def}|Acc]); - {'ValueFromObject',{_,Object},FieldName} -> - {_,Def} = get_referenced_type(S,Object), - TypeDef = get_fieldname_element(S,Def,FieldName), - (TypeDef#typedef.typespec)#'ObjectSet'.set; + {'ValueFromObject',{object,Object},FieldNames} -> + case extract_field(S, Object, FieldNames) of + #'Object'{def=Def} -> + check_object_list(S, ClassRef, Objs, + [{{no_mod,no_name},Def}|Acc]); + _ -> + asn1_error(S, S#state.type, illegal_object) + end; ObjSet when is_record(ObjSet,type) -> ObjSetDef = case ObjSet#type.def of @@ -1256,13 +1260,45 @@ osfo_intersection(InterSect,ObjList) -> Res end. -%% get_fieldname_element/3 -%% gets the type/value/object/... of the referenced element in FieldName -%% FieldName is a list and may have more than one element. -%% Each element in FieldName can be either {typefieldreference,AnyFieldName} -%% or {valuefieldreference,AnyFieldName} -%% Def is the def of the first object referenced by FieldName -get_fieldname_element(S,Def,[{_RefType,FieldName}]) when is_record(Def,typedef) -> +%% get_type_from_object(State, ObjectOrObjectSet, [{RefType,FieldName}]) -> +%% Type +get_type_from_object(S, Object, FieldNames) + when is_record(Object, 'Externaltypereference'); + is_record(Object, 'Externalvaluereference') -> + extract_field(S, Object, FieldNames). + +%% get_value_from_object(State, ObjectOrObjectSet, [{RefType,FieldName}]) -> +%% UntaggedValue +get_value_from_object(S, Def, FieldNames) -> + case extract_field(S, Def, FieldNames) of + #valuedef{value=Val} -> + Val; + _ -> + asn1_error(S, Def, illegal_value) + end. + +%% extract_field(State, ObjectOrObjectSet, [{RefType,FieldName}]) +%% RefType = typefieldreference | valuefieldreference +%% +%% Get the type, value, object, object set, or value set from the +%% referenced object or object set. The list of field name tuples +%% may have more than one element. All field names but the last +%% refers to either an object or object set. + +extract_field(S, Def0, FieldNames) -> + {_,Def1} = get_referenced_type(S, Def0), + Def2 = check_object(S, Def1, Def1#typedef.typespec), + Def = Def1#typedef{typespec=Def2}, + get_fieldname_element(S, Def, FieldNames). + +%% get_fieldname_element(State, Element, [{RefType,FieldName}] +%% RefType = typefieldreference | valuefieldreference +%% +%% Get the type, value, object, object set, or value set from the referenced +%% element. The list of field name tuples may have more than one element. +%% All field names but the last refers to either an object or object set. + +get_fieldname_element(S, #typedef{}=Def, [{_RefType,FieldName}]) -> {_,_,ObjComps} = (Def#typedef.typespec)#'Object'.def, check_fieldname_element(S,lists:keysearch(FieldName,1,ObjComps)); get_fieldname_element(S,Def,[{_RefType,FieldName}|Rest]) @@ -1311,6 +1347,8 @@ check_fieldname_element(S, #valuedef{}=VDef) -> NewDef = #typedef{checked=C,pos=Pos,name=N,typespec=NewSpec}, check_fieldname_element(S, NewDef) end; +check_fieldname_element(_S, {value_tag,Val}) -> + #valuedef{value=Val}; check_fieldname_element(S,Eref) when is_record(Eref,'Externaltypereference'); is_record(Eref,'Externalvaluereference') -> @@ -1968,13 +2006,16 @@ get_objectset_def(_S,ObjFieldSetting={{'SingleValue',_},_},CField) -> %% a Union of defined objects ?dbg("objectsetfield, SingleValue~n",[]), union_of_defed_objs(CField,ObjFieldSetting); -get_objectset_def(S,{object,_,[#type{def={'TypeFromObject', - {object,RefedObj}, - FieldName}}]},_CField) -> - %% This case occurs when an ObjectSetFromObjects - %% production is used - {_M,Def} = get_referenced_type(S,RefedObj), - get_fieldname_element(S,Def,FieldName); +get_objectset_def(S, {object,_, + [#type{def={'TypeFromObject', + {object,Object}, + FieldNames}}]}, + CField) -> + %% This case occurs when an ObjectSetFromObject + %% production is used. + Def = #typedef{checked=true, + typespec=extract_field(S, Object, FieldNames)}, + get_objectset_def2(S, Def, CField); get_objectset_def(S,{object,_,[{setting,_,ERef}]},CField) when is_record(ERef,'Externaltypereference') -> {_,T} = get_referenced_type(S,ERef), @@ -2496,6 +2537,13 @@ normalize_integer(S, #'Externalvaluereference'{value=Name}=Ref, NNL) -> asn1_error(S, S#state.value, illegal_integer_value) end end; +normalize_integer(S, {'ValueFromObject',{object,Obj},FieldNames}, _) -> + case extract_field(S, Obj, FieldNames) of + #valuedef{value=Val} when is_integer(Val) -> + Val; + _ -> + asn1_error(S, S#state.value, illegal_integer_value) + end; normalize_integer(#state{value=Val}=S, _, _) -> asn1_error(S, Val, illegal_integer_value). @@ -3357,13 +3405,6 @@ get_innertag(_S,#'ObjectClassFieldType'{type=Type}) -> _ -> [] end. -get_type_from_object(S,Object,TypeField) - when is_record(Object,'Externaltypereference'); - is_record(Object,'Externalvaluereference') -> - {_,ObjectDef} = get_referenced_type(S,Object), - ObjSpec = check_object(S,ObjectDef,ObjectDef#typedef.typespec), - get_fieldname_element(S,ObjectDef#typedef{typespec=ObjSpec},TypeField). - %% get_class_def(S, Type) -> #classdef{} | 'none'. get_class_def(S, #typedef{typespec=#type{def=#'Externaltypereference'{}=Eref}}) -> {_,NextDef} = get_referenced_type(S, Eref), @@ -3708,44 +3749,28 @@ resolv_value1(S, {gt,V}) -> case resolv_value1(S, V) of Int when is_integer(Int) -> Int + 1; - Other -> - throw({error,{asn1,{not_integer_value,Other}}}) + _Other -> + asn1_error(S, S#state.type, illegal_integer_value) end; resolv_value1(S, {lt,V}) -> case resolv_value1(S, V) of Int when is_integer(Int) -> Int - 1; - Other -> - throw({error,{asn1,{not_integer_value,Other}}}) + _Other -> + asn1_error(S, S#state.type, illegal_integer_value) end; -resolv_value1(S,{'ValueFromObject',{object,Object},[{valuefieldreference, - FieldName}]}) -> - %% FieldName can hold either a fixed-type value or a variable-type value - %% Object is a DefinedObject, i.e. a #'Externaltypereference' - resolve_value_from_object(S,Object,FieldName); +resolv_value1(S, {'ValueFromObject',{object,Object},FieldName}) -> + get_value_from_object(S, Object, FieldName); resolv_value1(_,#valuedef{checked=true,value=V}) -> V; -resolv_value1(S,#valuedef{type=_T, - value={'ValueFromObject',{object,Object}, - [{valuefieldreference, - FieldName}]}}) -> - resolve_value_from_object(S,Object,FieldName); +resolv_value1(S, #valuedef{value={'ValueFromObject', + {object,Object},FieldName}}) -> + get_value_from_object(S, Object, FieldName); resolv_value1(S,VDef = #valuedef{}) -> #valuedef{value=Val} = check_value(S,VDef), Val; resolv_value1(_,V) -> V. -resolve_value_from_object(S,Object,FieldName) -> - {_,ObjTDef} = get_referenced_type(S,Object), - TS = check_object(S,ObjTDef,ObjTDef#typedef.typespec), - {_,_,Components} = TS#'Object'.def, - case lists:keysearch(FieldName,1,Components) of - {value,{_,#valuedef{value=Val}}} -> - Val; - _ -> - error({value,"illegal value in constraint",S}) - end. - resolve_namednumber(S,#typedef{typespec=Type},Name) -> case Type#type.def of @@ -3874,19 +3899,9 @@ check_constraint(S,{simpletable,Type}) -> #'ObjectSet'{} -> io:format("ALERT: simpletable forbidden case!~n",[]), {simpletable,check_object(S,Type,C)}; - {'ValueFromObject',{_,ORef},FieldName} -> - %% This is an ObjectFromObject - {_,Object} = get_referenced_type(S,ORef), - ChObject = check_object(S,Object, - Object#typedef.typespec), - ObjFromObj= - get_fieldname_element(S,Object#typedef{ - typespec=ChObject}, - FieldName), - {simpletable,ObjFromObj}; -%% ObjFromObj#typedef{checked=true,typespec= -%% check_object(S,ObjFromObj, -%% ObjFromObj#typedef.typespec)}}; + {'ValueFromObject',{_,Object},FieldNames} -> + %% This is an ObjectFromObject. + {simpletable,extract_field(S, Object, FieldNames)}; _ -> check_type(S,S#state.tname,Type),%% this seems stupid. OSName = Def#'Externaltypereference'.type, @@ -6692,10 +6707,14 @@ format_error({illegal_instance_of,Class}) -> [Class]); format_error(illegal_integer_value) -> "expecting an integer value"; +format_error(illegal_object) -> + "expecting an object"; format_error(illegal_octet_string_value) -> "expecting a bstring or an hstring as value for an OCTET STRING"; format_error({illegal_typereference,Name}) -> io_lib:format("'~p' is used as a typereference, but does not start with an uppercase letter", [Name]); +format_error(illegal_value) -> + "expected a value"; format_error({invalid_fields,Fields,Obj}) -> io_lib:format("invalid ~s in ~p", [format_fields(Fields),Obj]); format_error({invalid_bit_number,Bit}) -> -- cgit v1.2.3 From 56ab55449e38de8b28df5e2b7e3e6bbebfecd1ba Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 15 May 2014 15:24:04 +0200 Subject: Use object_to_check/1 in two forgotten places An #'Externavaluereference'{} may either be a value or an object. In places where objects are expected, we will need to call object_to_check/1 to convert an #'Externavaluereference'{} to an object. It was forgotten in two places. --- lib/asn1/src/asn1ct_check.erl | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index fc15cfbb88..79d55feb9f 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -794,7 +794,7 @@ check_object(S,_ObjDef,#'Object'{classname=ClassRef,def=ObjectDef}) -> instantiate_po(S,ClassDef,Object,ArgList); #'Externalvaluereference'{} -> {_,Object} = get_referenced_type(S,ObjectDef), - check_object(S,Object,Object#typedef.typespec); + check_object(S, Object, object_to_check(Object)); [] -> %% An object with no fields. All class fields must be %% optional or default. Check that all fields in @@ -835,8 +835,7 @@ check_object(S, {'SingleValue',ERef = #'Externalvaluereference'{}} -> {RefedMod,ObjDef} = get_referenced_type(S,ERef), #'Object'{def=CheckedObj} = - check_object(S,ObjDef,ObjDef#typedef.typespec), - + check_object(S, ObjDef, object_to_check(ObjDef)), NewSet = get_unique_valuelist(S,[{{RefedMod,get_datastr_name(ObjDef)}, CheckedObj}], UniqueInfo), -- cgit v1.2.3 From 8e43bffda5069aecdd2375eb409e9c03b7ff692b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 13 Oct 2014 15:59:27 +0200 Subject: Simplify handling of an empty object definition When the parser sees: something SOMETHING ::= {} it has no way of knowing whether 'something' is an value or an object. It depends on how SOMETHING is defined. For example: SOMETHING ::= SEQUENCE {} or SOMETHING ::= CLASS { &id OPTIONAL } Because of that ambiguity, there is no way to avoid a special case when we check an object definition. However, there is no need to invent an entire new checking function for this special case. It is much easier to just pretend that the parser gave us {object,defaultsyntax,[]} and let check_objectdefn/3 check it in the usual way. --- lib/asn1/src/asn1ct_check.erl | 28 ++++------------------------ 1 file changed, 4 insertions(+), 24 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 79d55feb9f..aba0e6a9ef 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -796,13 +796,10 @@ check_object(S,_ObjDef,#'Object'{classname=ClassRef,def=ObjectDef}) -> {_,Object} = get_referenced_type(S,ObjectDef), check_object(S, Object, object_to_check(Object)); [] -> - %% An object with no fields. All class fields must be - %% optional or default. Check that all fields in - %% class are 'OPTIONAL' or 'DEFAULT' - class_fields_optional_check(S,ClassDef), - #'Object'{def={object,defaultsyntax,[]}}; - _ -> - exit({error,{no_object,ObjectDef},S}) + %% An object with no fields (parsed as a value). + Def = {object,defaultsyntax,[]}, + NewSettingList = check_objectdefn(S, Def, ClassDef), + #'Object'{def=NewSettingList} end, Gen = gen_incl(S,NewObj#'Object'.def, (ClassDef#classdef.typespec)#objectclass.fields), @@ -967,23 +964,6 @@ prepare_objset({#type{}=Type,#type{}=Ext}) -> prepare_objset(Ret) -> Ret. -class_fields_optional_check(S,#classdef{typespec=ClassSpec}) -> - Fields = ClassSpec#objectclass.fields, - class_fields_optional_check1(S,Fields). - -class_fields_optional_check1(_S,[]) -> - ok; -class_fields_optional_check1(S,[{typefield,_,'OPTIONAL'}|Rest]) -> - class_fields_optional_check1(S,Rest); -class_fields_optional_check1(S,[{fixedtypevaluefield,_,_,_,'OPTIONAL'}|Rest]) -> - class_fields_optional_check1(S,Rest); -class_fields_optional_check1(S,[{fixedtypevaluesetfield,_,_,'OPTIONAL'}|Rest]) -> - class_fields_optional_check1(S,Rest); -class_fields_optional_check1(S,[{objectfield,_,_,_,'OPTIONAL'}|Rest]) -> - class_fields_optional_check1(S,Rest); -class_fields_optional_check1(S,[{objectsetfield,_,_,'OPTIONAL'}|Rest]) -> - class_fields_optional_check1(S,Rest). - %% ObjectSetFromObjects functionality %% The fieldname is a list of field names.They may be objects or -- cgit v1.2.3 From 33b19f4ed08f84459ed762dbb50ea0cf148ebfd3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 2 Sep 2014 13:16:53 +0200 Subject: Rewrite matching of object definitions using the simplified syntax Rewrite the confusing and buggy matching of an object definition against the simplified syntax. While we are at it, we will also add proper error handling. --- lib/asn1/src/asn1ct_check.erl | 847 +++++++++++++++++------------------------- 1 file changed, 343 insertions(+), 504 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index aba0e6a9ef..14ffc61068 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -578,9 +578,8 @@ check_class(S = #state{mname=M,tname=T},ClassSpec) TmpParam <- Params], instantiate_pclass(S,PClassDef,NewParaList) end; -check_class(S,C) when is_record(C,objectclass) -> - NewFieldSpec = check_class_fields(S,C#objectclass.fields), - C#objectclass{fields=NewFieldSpec}; +check_class(S, #objectclass{}=C) -> + check_objectclass(S, C); check_class(_S,{poc,_ObjSet,_Params}) -> 'fix this later'; check_class(S,ClassName) -> @@ -610,6 +609,16 @@ check_class(S,ClassName) -> end end. +check_objectclass(S, #objectclass{fields=Fs0,syntax=Syntax0}=C) -> + Fs = check_class_fields(S, Fs0), + case Syntax0 of + {'WITH SYNTAX',Syntax1} -> + Syntax = preprocess_syntax(S, Syntax1, Fs), + C#objectclass{fields=Fs,syntax={preprocessed_syntax,Syntax}}; + _ -> + C#objectclass{fields=Fs} + end. + instantiate_pclass(S=#state{parameters=_OldArgs},PClassDef,Params) -> #ptypedef{args=Args,typespec=Type} = PClassDef, MatchedArgs = match_args(S,Args, Params, []), @@ -780,7 +789,7 @@ check_object(S,_ObjDef,#'Object'{classname=ClassRef,def=ObjectDef}) -> end, NewObj = case ObjectDef of - Def when is_tuple(Def), (element(1,Def)==object) -> + {object,_,_}=Def -> NewSettingList = check_objectdefn(S,Def,ClassDef), #'Object'{def=NewSettingList}; {po,{object,DefObj},ArgsList} -> @@ -1562,32 +1571,304 @@ gen_incl_set1(S,[Object|Rest],CFields)-> gen_incl_set1(S,Rest,CFields) end. -check_objectdefn(S,Def,CDef) when is_record(CDef,classdef) -> - WithSyntax = (CDef#classdef.typespec)#objectclass.syntax, - ClassFields = (CDef#classdef.typespec)#objectclass.fields, + +%%% +%%% Check an object definition. +%%% + +check_objectdefn(S, Def, #classdef{typespec=ObjClass}) -> + #objectclass{syntax=Syntax0,fields=ClassFields} = ObjClass, case Def of {object,defaultsyntax,Fields} -> - check_defaultfields(S,Fields,ClassFields); + check_defaultfields(S, Fields, ClassFields); {object,definedsyntax,Fields} -> - {_,WSSpec} = WithSyntax, - NewFields = - case catch( convert_definedsyntax(S,Fields,WSSpec, - ClassFields,[])) of - {asn1,{_ErrorType,ObjToken,ClassToken}} -> - throw({asn1,{'match error in object',ObjToken, - 'found in object',ClassToken,'found in class'}}); - Err={asn1,_} -> throw(Err); - Err={'EXIT',_} -> throw(Err); - DefaultFields when is_list(DefaultFields) -> - DefaultFields - end, - {object,defaultsyntax,NewFields}; - {object,_ObjectId} -> % This is a DefinedObject - fixa; - Other -> - exit({error,{objectdefn,Other}}) + Syntax = get_syntax(S, Syntax0, ClassFields), + case match_syntax(S, Syntax, Fields, []) of + {match,NewFields,[]} -> + {object,defaultsyntax,NewFields}; + {match,_,[What|_]} -> + syntax_match_error(S, What); + {nomatch,[What|_]} -> + syntax_match_error(S, What); + {nomatch,[]} -> + syntax_match_error(S) + end end. +get_syntax(_, {preprocessed_syntax,Syntax}, _) -> + Syntax; +get_syntax(S, {'WITH SYNTAX',Syntax}, ClassFields) -> + preprocess_syntax(S, Syntax, ClassFields). + + +%%% +%%% Pre-process the simplified syntax so that it can be more +%%% easily matched. +%%% + +preprocess_syntax(S, [H|T], Cs) when is_list(H) -> + [{optional,preprocess_syntax(S, H, Cs)}|preprocess_syntax(S, T, Cs)]; +preprocess_syntax(S, [{valuefieldreference,Name}|T], Cs) -> + case lists:keyfind(Name, 2, Cs) of + Tuple when is_tuple(Tuple) -> + [{field,Tuple}|preprocess_syntax(S, T, Cs)]; + false -> + asn1_error(S, S#state.type, {syntax_undefined_field,Name}) + end; +preprocess_syntax(S, [{typefieldreference,Name}|T], Cs) -> + case lists:keyfind(Name, 2, Cs) of + Tuple when is_tuple(Tuple) -> + [{field,Tuple}|preprocess_syntax(S, T, Cs)]; + false -> + asn1_error(S, S#state.type, {syntax_undefined_field,Name}) + end; +preprocess_syntax(S,[{Token,_}|T], Cs) when is_atom(Token) -> + [{token,Token}|preprocess_syntax(S, T, Cs)]; +preprocess_syntax(S, [Token|T], Cs) when is_atom(Token) -> + [{token,Token}|preprocess_syntax(S, T, Cs)]; +preprocess_syntax(_, [], _) -> []. + +match_syntax(S, [{token,Token}|T], [A|As]=Args, Acc) -> + case A of + {word_or_setting,_,#'Externaltypereference'{type=Token}} -> + match_syntax(S, T, As, Acc); + {Token,Line} when is_integer(Line) -> + match_syntax(S, T, As, Acc); + _ -> + {nomatch,Args} + end; +match_syntax(S, [{field,Field}|T]=Fs, [A|As0]=Args0, Acc) -> + try match_syntax_type(S, Field, A) of + {match,Match} -> + match_syntax(S, T, As0, lists:reverse(Match)++Acc); + {params,_Name,#ptypedef{args=Params}=P,Ref} -> + {Args,As} = lists:split(length(Params), As0), + Val = match_syntax_params(S, P, Ref, Args), + match_syntax(S, Fs, [Val|As], Acc) + catch + _:_ -> + {nomatch,Args0} + end; +match_syntax(S, [{optional,L}|T], As0, Acc) -> + case match_syntax(S, L, As0, []) of + {match,Match,As} -> + match_syntax(S, T, As, lists:reverse(Match)++Acc); + {nomatch,As0} -> + match_syntax(S, T, As0, Acc); + {nomatch,_}=NoMatch -> + NoMatch + end; +match_syntax(_, [_|_], [], _Acc) -> + {nomatch,[]}; +match_syntax(_, [], As, Acc) -> + {match,lists:reverse(Acc),As}. + +match_syntax_type(S, Type, {value_tag,Val}) -> + match_syntax_type(S, Type, Val); +match_syntax_type(S, Type, {setting,_,Val}) -> + match_syntax_type(S, Type, Val); +match_syntax_type(S, Type, {word_or_setting,_,Val}) -> + match_syntax_type(S, Type, Val); +match_syntax_type(_S, _Type, {Atom,Line}) + when is_atom(Atom), is_integer(Line) -> + throw(nomatch); +match_syntax_type(S, {fixedtypevaluefield,Name,#type{}=T,_,_}=Type, + #'Externalvaluereference'{}=ValRef0) -> + try get_referenced_type(S, ValRef0) of + {M,#valuedef{}=ValDef} -> + match_syntax_type(update_state(S, M), Type, ValDef) + catch + throw:{error,_} -> + ValRef = #valuedef{name=Name, + type=T, + value=ValRef0, + module=S#state.mname}, + match_syntax_type(S, Type, ValRef) + end; +match_syntax_type(S, {fixedtypevaluefield,Name,#type{},_,_}, #valuedef{}=Val0) -> + Val = check_value(S, Val0), + {match,[{Name,Val}]}; +match_syntax_type(S, {fixedtypevaluefield,Name,#type{},_,_}, + {'ValueFromObject',{object,Object},FieldNames}) -> + Val = extract_field(S, Object, FieldNames), + {match,[{Name,Val}]}; +match_syntax_type(S, {fixedtypevaluefield,Name,#type{}=T,_,_}=Type, Any) -> + ValDef = #valuedef{name=Name,type=T,value=Any,module=S#state.mname}, + match_syntax_type(S, Type, ValDef); +match_syntax_type(_S, {fixedtypevaluesetfield,Name,#type{},_}, Any) -> + {match,[{Name,Any}]}; +match_syntax_type(S, {objectfield,Name,_,_,_}, #'Externalvaluereference'{}=Ref) -> + {M,Obj} = get_referenced_type(S, Ref), + check_object(S, Obj, object_to_check(Obj)), + {match,[{Name,Ref#'Externalvaluereference'{module=M}}]}; +match_syntax_type(S, {objectfield,Name,Class,_,_}, {object,_,_}=ObjDef) -> + InlinedObjName = list_to_atom(lists:concat([S#state.tname, + '_',Name])), + ObjSpec = #'Object'{classname=Class,def=ObjDef}, + CheckedObj = check_object(S, #typedef{typespec=ObjSpec}, ObjSpec), + InlObj = #typedef{checked=true,name=InlinedObjName,typespec=CheckedObj}, + ObjKey = {InlinedObjName, InlinedObjName}, + insert_once(S, inlined_objects, ObjKey), + %% Which module to use here? Could it be other than top_module? + asn1_db:dbput(get(top_module), InlinedObjName, InlObj), + {match,[{Name,InlObj}]}; +match_syntax_type(_S, {objectfield,Name,_,_,_}, Any) -> + {match,[{Name,Any}]}; +match_syntax_type(S, {objectsetfield,Name,CDef0,_}, Any) -> + CDef = case CDef0 of + #type{def=CDef1} -> CDef1; + CDef1 -> CDef1 + end, + case match_syntax_objset(S, Any, CDef) of + #typedef{typespec=#'ObjectSet'{}=Ts0}=Def -> + Ts = check_object(S, Def, Ts0), + {match,[{Name,Def#typedef{checked=true,typespec=Ts}}]}; + _ -> + syntax_match_error(S, Any) + end; +match_syntax_type(S, {typefield,Name0,_}, #type{def={pt,_,_}=Def}=Actual) -> + %% This is an inlined type. If constructed type, save in data base. + T = check_type(S, #typedef{typespec=Actual}, Actual), + #'Externaltypereference'{type=PtName} = element(2, Def), + NameList = [PtName,S#state.tname], + Name = list_to_atom(asn1ct_gen:list2name(NameList)), + NewTDef = #typedef{checked=true,name=Name,typespec=T}, + asn1_db:dbput(S#state.mname, Name, NewTDef), + insert_once(S, parameterized_objects, {Name,type,NewTDef}), + {match,[{Name0,NewTDef}]}; +match_syntax_type(S, {typefield,Name,_}, #type{def=#'ObjectClassFieldType'{}}=Actual) -> + T = check_type(S, #typedef{typespec=Actual}, Actual), + {match,[{Name,ocft_def(T)}]}; +match_syntax_type(S, {typefield,Name,_}, #type{def=#'Externaltypereference'{}=Ref}) -> + match_syntax_external(S, Name, Ref); +match_syntax_type(S, {typefield,Name,_}, #type{def=Def}=Actual) -> + T = check_type(S, #typedef{typespec=Actual}, Actual), + TypeName = asn1ct_gen:type(asn1ct_gen:get_inner(Def)), + {match,[{Name,#typedef{checked=true,name=TypeName,typespec=T}}]}; +match_syntax_type(S, {typefield,Name,_}, #'Externaltypereference'{}=Ref) -> + match_syntax_external(S, Name, Ref); +match_syntax_type(_S, {variabletypevaluefield,Name,_,_}, Any) -> + {match,[{Name,Any}]}; +match_syntax_type(_S, {variabletypevaluesetfield,Name,_,_}, Any) -> + {match,[{Name,Any}]}; +match_syntax_type(_S, _Type, _Actual) -> + throw(nomatch). + +match_syntax_params(S0, #ptypedef{name=Name}=PtDef, + #'Externaltypereference'{module=M,type=N}=ERef0, Args) -> + S = S0#state{mname=M,module=load_asn1_module(S0, M), + type=PtDef,tname=Name}, + Type = check_type(S, PtDef, #type{def={pt,ERef0,Args}}), + ERefName = new_reference_name(N), + ERef = #'Externaltypereference'{type=ERefName,module=S0#state.mname}, + TDef = #typedef{checked=true,name=ERefName,typespec=Type}, + insert_once(S0, parameterized_objects, {ERefName,type,TDef}), + asn1_db:dbput(S0#state.mname, ERef#'Externaltypereference'.type, TDef), + ERef. + +match_syntax_external(#state{mname=Mname}=S0, Name, Ref0) -> + {M,T0} = get_referenced_type(S0, Ref0), + Ref1 = Ref0#'Externaltypereference'{module=M}, + case T0 of + #ptypedef{} -> + {params,Name,T0,Ref1}; + #typedef{checked=false}=TDef0 when Mname =/= M -> + %% This typedef is an imported type (or maybe a set.asn + %% compilation). + S = S0#state{mname=M,module=load_asn1_module(S0, M), + type=TDef0,tname=get_datastr_name(TDef0)}, + Type = check_type(S, TDef0, TDef0#typedef.typespec), + TDef = TDef0#typedef{checked=true,typespec=Type}, + asn1_db:dbput(M, get_datastr_name(TDef), TDef), + {match,[{Name,merged_name(S, Ref1)}]}; + TDef -> + %% This might be a renamed type in a set of specs, + %% so rename the ref. + Type = asn1ct:get_name_of_def(TDef), + Ref = Ref1#'Externaltypereference'{type=Type}, + {match,[{Name,Ref}]} + end. + +match_syntax_objset(S, #'Externaltypereference'{}=Ref, _) -> + {_,T} = get_referenced_type(S, Ref), + T; +match_syntax_objset(S, #'Externalvaluereference'{}=Ref, _) -> + {_,T} = get_referenced_type(S, Ref), + T; +match_syntax_objset(_, [_|_]=Set, ClassDef) -> + make_objset(ClassDef, Set); +match_syntax_objset(_, {'SingleValue',_}=Set, ClassDef) -> + make_objset(ClassDef, Set); +match_syntax_objset(_, {{'SingleValue',_},_}=Set, ClassDef) -> + make_objset(ClassDef, Set); +match_syntax_objset(S, {object,definedsyntax,Words}, ClassDef) -> + case Words of + [Word] -> + match_syntax_objset_1(S, Word, ClassDef); + [_|_] -> + %% More than one word does not make sense. + none + end; +match_syntax_objset(S, #type{def=#'Externaltypereference'{}=Set}, ClassDef) -> + match_syntax_objset(S, Set, ClassDef); +match_syntax_objset(_, #type{}, _) -> + none. + +match_syntax_objset_1(S, {setting,_,Set}, ClassDef) -> + %% Word that starts with an uppercase letter. + match_syntax_objset(S, Set, ClassDef); +match_syntax_objset_1(S, {word_or_setting,_,Set}, ClassDef) -> + %% Word in uppercase/hyphens only. + match_syntax_objset(S, Set, ClassDef); +match_syntax_objset_1(S, #type{def={'TypeFromObject', + {object,Object}, + FieldNames}}, _) -> + #typedef{checked=true,typespec=extract_field(S, Object, FieldNames)}; +match_syntax_objset_1(_, #type{def=#'ObjectClassFieldType'{}}=Set, ClassDef) -> + make_objset(ClassDef, Set). + +make_objset(ClassDef, Set) -> + #typedef{typespec=#'ObjectSet'{class=ClassDef,set=Set}}. + +syntax_match_error(#state{type=Type}=S) -> + asn1_error(S, Type, syntax_nomatch). + +syntax_match_error(#state{type=Type}=S, What0) -> + What = printable_string(What0), + asn1_error(S, Type, {syntax_nomatch,What}). + +printable_string(Def) -> + printable_string_1(Def). + +printable_string_1({word_or_setting,_,Def}) -> + printable_string_1(Def); +printable_string_1({value_tag,V}) -> + printable_string_1(V); +printable_string_1({#seqtag{val=Val1},Val2}) -> + atom_to_list(Val1) ++ " " ++ printable_string_1(Val2); +printable_string_1(#type{def=Def}) -> + atom_to_list(asn1ct_gen:get_inner(Def)); +printable_string_1(#'Externaltypereference'{type=Type}) -> + atom_to_list(Type); +printable_string_1(#'Externalvaluereference'{value=Type}) -> + atom_to_list(Type); +printable_string_1({Atom,Line}) when is_atom(Atom), is_integer(Line) -> + q(Atom); +printable_string_1({object,definedsyntax,L}) -> + q(string:join([printable_string_1(Item) || Item <- L], " ")); +printable_string_1([_|_]=Def) -> + case lists:all(fun is_integer/1, Def) of + true -> + lists:flatten(io_lib:format("~p", [Def])); + false -> + q(string:join([printable_string_1(Item) || Item <- Def], " ")) + end; +printable_string_1(Def) -> + lists:flatten(io_lib:format("~p", [Def])). + +q(S) -> + lists:concat(["\"",S,"\""]). + check_defaultfields(S, Fields, ClassFields) -> Present = ordsets:from_list([F || {F,_} <- Fields]), Mandatory0 = get_mandatory_class_fields(ClassFields), @@ -1611,23 +1892,8 @@ check_defaultfields_1(_S, [], _ClassFields, Acc) -> {object,defaultsyntax,lists:reverse(Acc)}; check_defaultfields_1(S, [{FName,Spec}|Fields], ClassFields, Acc) -> CField = lists:keyfind(FName, 2, ClassFields), - {NewField,RestFields} = - convert_to_defaultfield(S, FName, [Spec|Fields], CField), - check_defaultfields_1(S, RestFields, ClassFields, [NewField|Acc]). - -convert_definedsyntax(_S,[],[],_ClassFields,Acc) -> - lists:reverse(Acc); -convert_definedsyntax(S,Fields,WithSyntax,ClassFields,Acc) -> - {MatchedField,RestFields,RestWS} = - match_field(S,Fields,WithSyntax,ClassFields), - if - is_list(MatchedField) -> - convert_definedsyntax(S,RestFields,RestWS,ClassFields, - lists:append(MatchedField,Acc)); - true -> - convert_definedsyntax(S,RestFields,RestWS,ClassFields, - [MatchedField|Acc]) - end. + {match,Match} = match_syntax_type(S, CField, Spec), + check_defaultfields_1(S, Fields, ClassFields, Match++Acc). get_mandatory_class_fields([{fixedtypevaluefield,Name,_,_,'MANDATORY'}|T]) -> [Name|get_mandatory_class_fields(T)]; @@ -1646,395 +1912,6 @@ get_mandatory_class_fields([_|T]) -> get_mandatory_class_fields(T); get_mandatory_class_fields([]) -> []. -match_field(S,Fields,WithSyntax,ClassFields) -> - match_field(S,Fields,WithSyntax,ClassFields,[]). - -match_field(S,Fields,[W|Ws],ClassFields,Acc) when is_list(W) -> - case catch(match_optional_field(S,Fields,W,ClassFields,[])) of - {'EXIT',_} -> - match_field(Fields,Ws,ClassFields,Acc); %% add S -%% {[Result],RestFields} -> -%% {Result,RestFields,Ws}; - {Result,RestFields} when is_list(Result) -> - {Result,RestFields,Ws}; - _ -> - match_field(S,Fields,Ws,ClassFields,Acc) - end; -match_field(S,Fields,WithSyntax,ClassFields,_Acc) -> - match_mandatory_field(S,Fields,WithSyntax,ClassFields,[]). - -match_optional_field(_S,RestFields,[],_,Ret) -> - {Ret,RestFields}; -%% An additional optional field within an optional field -match_optional_field(S,Fields,[W|Ws],ClassFields,Ret) when is_list(W) -> - case catch match_optional_field(S,Fields,W,ClassFields,[]) of - {'EXIT',_} when length(Ws) > 0 -> - match_optional_field(S,Fields,Ws,ClassFields,Ret); - {'EXIT',_} -> - {Ret,Fields}; - {asn1,{optional_matcherror,_,_}} when length(Ws) > 0 -> - match_optional_field(S,Fields,Ws,ClassFields,Ret); - {asn1,{optional_matcherror,_,_}} -> - {Ret,Fields}; - {OptionalField,RestFields} -> - match_optional_field(S,RestFields,Ws,ClassFields, - lists:append(OptionalField,Ret)) - end; -%% identify and skip word -match_optional_field(S,[{_,_,#'Externaltypereference'{type=WorS}}|Rest], - [WorS|Ws],ClassFields,Ret) -> - match_optional_field(S,Rest,Ws,ClassFields,Ret); -match_optional_field(S,[],_,ClassFields,Ret) -> - match_optional_field(S,[],[],ClassFields,Ret); -%% identify and skip comma -match_optional_field(S,[{WorS,_}|Rest],[{WorS,_}|Ws],ClassFields,Ret) -> - match_optional_field(S,Rest,Ws,ClassFields,Ret); -%% am optional setting inside another optional setting may be "double-listed" -match_optional_field(S,[Setting],DefinedSyntax,ClassFields,Ret) - when is_list(Setting) -> - match_optional_field(S,Setting,DefinedSyntax,ClassFields,Ret); -%% identify and save field data -match_optional_field(S,[Setting|Rest],[{_,W}|Ws],ClassFields,Ret) -> - ?dbg("matching optional field setting: ~p with user friendly syntax: ~p~n",[Setting,W]), - WorS = - case Setting of - Type when is_record(Type,type) -> Type; - {'ValueFromObject',_,_} -> Setting; - {object,_,_} -> Setting; - {_,_,WordOrSetting} -> WordOrSetting; - Other -> Other - end, - case lists:keysearch(W,2,ClassFields) of - false -> - throw({asn1,{optional_matcherror,WorS,W}}); - {value,CField} -> - {NewField,RestFields} = - convert_to_defaultfield(S,W,[WorS|Rest],CField), - match_optional_field(S,RestFields,Ws,ClassFields,[NewField|Ret]) - end; -match_optional_field(_S,[WorS|_Rest],[W|_Ws],_ClassFields,_Ret) -> - throw({asn1,{optional_matcherror,WorS,W}}). - -match_mandatory_field(_S,[],[],_,[Acc]) -> - {Acc,[],[]}; -match_mandatory_field(_S,[],[],_,Acc) -> - {Acc,[],[]}; -match_mandatory_field(S,[],[H|T],CF,Acc) when is_list(H) -> - match_mandatory_field(S,[],T,CF,Acc); -match_mandatory_field(_S,[],WithSyntax,_,_Acc) -> - throw({asn1,{mandatory_matcherror,[],WithSyntax}}); -%match_mandatory_field(_S,Fields,WithSyntax=[W|_Ws],_ClassFields,[Acc]) when is_list(W) -> -match_mandatory_field(_S,Fields,WithSyntax=[W|_Ws],_ClassFields,Acc) when is_list(W), length(Acc) >= 1 -> - {Acc,Fields,WithSyntax}; -%% identify and skip word -%%match_mandatory_field(S,[{_,_,WorS}|Rest], -match_mandatory_field(S,[{_,_,#'Externaltypereference'{type=WorS}}|Rest], - [WorS|Ws],ClassFields,Acc) -> - match_mandatory_field(S,Rest,Ws,ClassFields,Acc); -%% identify and skip comma -match_mandatory_field(S,[{WorS,_}|Rest],[{WorS,_}|Ws],ClassFields,Ret) -> - match_mandatory_field(S,Rest,Ws,ClassFields,Ret); -%% identify and save field data -match_mandatory_field(S,[Setting|Rest],[{_,W}|Ws],ClassFields,Acc) -> - ?dbg("matching field setting: ~p with user friendly syntax: ~p~n",[Setting,W]), - WorS = - case Setting of - {object,_,_} -> Setting; - {_,_,WordOrSetting} -> WordOrSetting; - Type when is_record(Type,type) -> Type; - Other -> Other - end, - case lists:keysearch(W,2,ClassFields) of - false -> - throw({asn1,{mandatory_matcherror,WorS,W}}); - {value,CField} -> - {NewField,RestFields} = - convert_to_defaultfield(S,W,[WorS|Rest],CField), - match_mandatory_field(S,RestFields,Ws,ClassFields,[NewField|Acc]) - end; - -match_mandatory_field(_S,[WorS|_Rest],[W|_Ws],_ClassFields,_Acc) -> - throw({asn1,{mandatory_matcherror,WorS,W}}). - -%% Converts a field of an object from defined syntax to default syntax -%% A field may be a type, a fixed type value, an object, an objectset, -%% -convert_to_defaultfield(S,ObjFieldName,[OFS|RestOFS],CField)-> - ?dbg("convert field: ~p of type: ~p~n",[ObjFieldName,element(1,CField)]), - CurrMod = S#state.mname, - Strip_value_tag = - fun({value_tag,ValueSetting}) -> ValueSetting; - (VS) -> VS - end, - ObjFieldSetting = Strip_value_tag(OFS), - RestSettings = [Strip_value_tag(X)||X <- RestOFS], - case element(1,CField) of - typefield -> - TypeDef= - case ObjFieldSetting of - TypeRec when is_record(TypeRec,type) -> TypeRec#type.def; - TDef when is_record(TDef,typedef) -> - TDef#typedef{checked=true, - typespec=check_type(S,TDef, - TDef#typedef.typespec)}; - _ -> ObjFieldSetting - end, - {Type,SettingsLeft} = - if - is_record(TypeDef,typedef) -> {TypeDef,RestSettings}; - is_record(TypeDef,'ObjectClassFieldType') -> - T=check_type(S,#typedef{typespec=ObjFieldSetting},ObjFieldSetting), - {oCFT_def(S,T),RestSettings}; -% #typedef{checked=true,name=Name,typespec=IT}; - is_tuple(TypeDef), element(1,TypeDef) == pt -> - %% this is an inlined type. If constructed - %% type save in data base - T=check_type(S,#typedef{typespec=ObjFieldSetting},ObjFieldSetting), - #'Externaltypereference'{type=PtName} = - element(2,TypeDef), - NameList = [PtName,S#state.tname], - NewName = list_to_atom(asn1ct_gen:list2name(NameList)), - NewTDef=#typedef{checked=true,name=NewName, - typespec=T}, - asn1_db:dbput(S#state.mname,NewName,NewTDef), - %%asn1ct_gen:insert_once(parameterized_objects,{NewName,type,NewTDef}), - insert_once(S,parameterized_objects, - {NewName,type,NewTDef}), - {NewTDef,RestSettings}; - is_tuple(TypeDef), element(1,TypeDef)=='SelectionType' -> - T=check_type(S,#typedef{typespec=ObjFieldSetting}, - ObjFieldSetting), - Name = type_name(S,T), - {#typedef{checked=true,name=Name,typespec=T},RestSettings}; - true -> - case asn1ct_gen:type(asn1ct_gen:get_inner(TypeDef)) of - ERef = #'Externaltypereference'{module=CurrMod} -> - {RefMod,T} = get_referenced_type(S,ERef), - check_and_save(S,ERef#'Externaltypereference'{module=RefMod},T,RestSettings); - - ERef = #'Externaltypereference'{} -> - {RefMod,T} = get_referenced_type(S,ERef), - check_and_save(S,ERef#'Externaltypereference'{module=RefMod},T,RestSettings); - Bif when Bif=={primitive,bif};Bif=={constructed,bif} -> - T = check_type(S,#typedef{typespec=ObjFieldSetting}, - ObjFieldSetting), - {#typedef{checked=true,name=Bif,typespec=T},RestSettings}; - _ -> - %this case should not happen any more - {Mod,T} = - get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=ObjFieldSetting}), - case Mod of - CurrMod -> - {T,RestSettings}; - ExtMod -> - #typedef{name=Name} = T, - {T#typedef{name={ExtMod,Name}},RestSettings} - end - end - end, - {{ObjFieldName,Type},SettingsLeft}; - fixedtypevaluefield -> - case ObjFieldName of - Val when is_atom(Val) -> - %% ObjFieldSetting can be a value,an objectidentifiervalue, - %% an element in an enumeration or namednumberlist etc. - ValRef = - case ObjFieldSetting of - ValSetting=#'Externalvaluereference'{} -> - ValSetting; - {'ValueFromObject',{_,ObjRef},FieldName} -> - {_,Object} = get_referenced_type(S,ObjRef), - ChObject = check_object(S,Object, - Object#typedef.typespec), - get_fieldname_element(S,Object#typedef{typespec=ChObject}, - FieldName); - ValSetting = #valuedef{} -> - ValSetting; - ValSetting -> - #valuedef{type=element(3,CField), - value=ValSetting, - module=S#state.mname} - end, - ?dbg("fixedtypevaluefield ValRef: ~p~n",[ValRef]), - case ValRef of - #valuedef{} -> - {{ObjFieldName,check_value(S,ValRef)},RestSettings}; - _ -> - ValDef = - case catch get_referenced_type(S,ValRef) of - {error,_} -> - NewValDef = - #valuedef{name=Val, - type=element(3,CField), - value=ObjFieldSetting, - module=S#state.mname}, - check_value(S,NewValDef); - {M,VDef} when is_record(VDef,valuedef) -> - check_value(update_state(S,M), - %%S#state{mname=M}, - VDef);%% XXX - {M,VDef} -> - check_value(update_state(S,M), - %%S#state{mname=M}, - #valuedef{name=Val, - type=element(3,CField), - value=VDef, - module=M}) - end, - {{ObjFieldName,ValDef},RestSettings} - end; - Val -> - {{ObjFieldName,Val},RestSettings} - end; - fixedtypevaluesetfield -> - {{ObjFieldName,ObjFieldSetting},RestSettings}; - objectfield -> - CheckObject = - fun(O) -> - O#typedef{checked=true,typespec= - check_object(S,O,O#typedef.typespec)} - end, - ObjectSpec = - case ObjFieldSetting of - Ref when is_record(Ref,'Externalvaluereference') -> - %% The object O might be a #valuedef{} if - %% e.g. the definition looks like - %% myobj SOMECLASS ::= referencedObject - {M,O} = get_referenced_type(S,Ref), - check_object(S,O,object_to_check(O)), - Ref#'Externalvaluereference'{module=M}; - - {'ValueFromObject',{_,ObjRef},FieldName} -> - %% This is an ObjectFromObject - {_,Object} = get_referenced_type(S,ObjRef), - ChObject = check_object(S,Object, - Object#typedef.typespec), - ObjFromObj= - get_fieldname_element(S,Object#typedef{ - typespec=ChObject}, - FieldName), - CheckObject(ObjFromObj); - ObjDef={object,_,_} -> - %% An object defined inlined in another object - %% class is an objectfield, that implies that - %% {objectsetfield,TypeFieldName,DefinedObjecClass, - %% OptionalitySpec} - %% DefinedObjecClass = #'Externaltypereference'{}| - %% 'TYPE-IDENTIFIER' | 'ABSTRACT-SYNTAX' - ClassName = element(3,CField), - InlinedObjName= - list_to_atom(lists:concat([S#state.tname]++ - ['_',ObjFieldName])), - - ObjSpec = #'Object'{classname=ClassName, - def=ObjDef}, - CheckedObj= - check_object(S,#typedef{typespec=ObjSpec},ObjSpec), - InlObj = #typedef{checked=true,name=InlinedObjName, - typespec=CheckedObj}, - ObjKey = {InlinedObjName,InlinedObjName}, - %% asn1ct_gen:insert_once(inlined_objects,ObjKey), - insert_once(S,inlined_objects,ObjKey), - %% Which module to use here? Could it be other than top_module ? - %% asn1_db:dbput(S#state.mname,InlinedObjName,InlObj), - asn1_db:dbput(get(top_module),InlinedObjName,InlObj), - InlObj; - #type{def=Eref} when is_record(Eref,'Externaltypereference') -> - {_,O} = get_referenced_type(S,Eref), - CheckObject(O); - Other -> - {_,O} = get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=Other}), - CheckObject(O) - end, - {{ObjFieldName,ObjectSpec},RestSettings}; - variabletypevaluefield -> - {{ObjFieldName,ObjFieldSetting},RestSettings}; - variabletypevaluesetfield -> - {{ObjFieldName,ObjFieldSetting},RestSettings}; -%% objectset_or_fixedtypevalueset_field -> -%% ok; - objectsetfield -> - ObjSetSpec = get_objectset_def(S,ObjFieldSetting,CField), - ?dbg("objectsetfield, ObjSetSpec:~p~n",[ObjSetSpec]), - {{ObjFieldName, - ObjSetSpec#typedef{checked=true, - typespec=check_object(S,ObjSetSpec, - ObjSetSpec#typedef.typespec)}},RestSettings} - end. - -get_objectset_def(S,Ref,CField) - when is_record(Ref,'Externaltypereference'); - is_record(Ref,'Externalvaluereference') -> - {_M,T}=get_referenced_type(S,Ref), - get_objectset_def2(S,T,CField); -get_objectset_def(S,ObjectList,CField) when is_list(ObjectList) -> - %% an objctset defined in the object,though maybe - %% parsed as a SequenceOfValue - %% The ObjectList may be a list of references to - %% objects, a ValueFromObject - ?dbg("objectsetfield: ~p~n",[CField]), - get_objectset_def2(S,ObjectList,CField); -get_objectset_def(S,'EXTENSIONMARK',CField) -> - ?dbg("objectsetfield: ~p~n",[CField]), - get_objectset_def2(S,['EXTENSIONMARK'],CField); -get_objectset_def(_S,ObjFieldSetting={'SingleValue',_},CField) -> - %% a Union of defined objects - ?dbg("objectsetfield, SingleValue~n",[]), - union_of_defed_objs(CField,ObjFieldSetting); -get_objectset_def(_S,ObjFieldSetting={{'SingleValue',_},_},CField) -> - %% a Union of defined objects - ?dbg("objectsetfield, SingleValue~n",[]), - union_of_defed_objs(CField,ObjFieldSetting); -get_objectset_def(S, {object,_, - [#type{def={'TypeFromObject', - {object,Object}, - FieldNames}}]}, - CField) -> - %% This case occurs when an ObjectSetFromObject - %% production is used. - Def = #typedef{checked=true, - typespec=extract_field(S, Object, FieldNames)}, - get_objectset_def2(S, Def, CField); -get_objectset_def(S,{object,_,[{setting,_,ERef}]},CField) - when is_record(ERef,'Externaltypereference') -> - {_,T} = get_referenced_type(S,ERef), - get_objectset_def2(S,T,CField); -get_objectset_def(S,#type{def=ERef},_CField) - when is_record(ERef,'Externaltypereference') -> - {_,T} = get_referenced_type(S,ERef), - T; -get_objectset_def(S,ObjFieldSetting,CField) - when is_atom(ObjFieldSetting) -> - ERef = #'Externaltypereference'{module=S#state.mname, - type=ObjFieldSetting}, - {_,T} = get_referenced_type(S,ERef), - get_objectset_def2(S,T,CField). - -get_objectset_def2(_S,T = #typedef{typespec=#'Object'{}},_CField) -> - #typedef{typespec=#'Object'{classname=Class,def=Def}} = T, - T#typedef{typespec=#'ObjectSet'{class=Class,set=[Def]}}; -get_objectset_def2(_S,Set,CField) when is_list(Set) -> - {_,_,Type,_} = CField, - ClassDef = Type#type.def, - #typedef{typespec=#'ObjectSet'{class=ClassDef, - set=Set}}; -get_objectset_def2(_S,T = #typedef{typespec=#'ObjectSet'{}},_CField) -> - T; -get_objectset_def2(S,T,_CField) -> - asn1ct:warning("get_objectset_def2: uncontrolled object set structure:~n~p~n", - [T],S,"get_objectset_def2: uncontrolled object set structure"). - -type_name(S,#type{def=Def}) -> - CurrMod = S#state.mname, - case asn1ct_gen:type(asn1ct_gen:get_inner(Def)) of - #'Externaltypereference'{module=CurrMod,type=Name} -> - Name; - #'Externaltypereference'{module=Mod,type=Name} -> - {Mod,Name}; - Bif when Bif=={primitive,bif};Bif=={constructed,bif} -> - Bif - end. - merged_name(#state{inputmodules=[]},ERef) -> ERef; merged_name(S,ERef=#'Externaltypereference'{module=M}) -> @@ -2049,38 +1926,18 @@ merged_name(S,ERef=#'Externaltypereference'{module=M}) -> ERef end. -oCFT_def(S,T) -> - case get_OCFT_inner(S,T) of - ERef=#'Externaltypereference'{} -> ERef; - {Name,Type} -> #typedef{checked=true,name=Name,typespec=Type}; - 'ASN1_OPEN_TYPE' -> - #typedef{checked=true,typespec=T#type{def='ASN1_OPEN_TYPE'}} - end. - -get_OCFT_inner(_S,T) -> -% Module=S#state.mname, - Def = T#type.def, - case Def#'ObjectClassFieldType'.type of +ocft_def(#type{def=#'ObjectClassFieldType'{type=OCFT}}=T) -> + case OCFT of {fixedtypevaluefield,_,InnerType} -> case asn1ct_gen:type(asn1ct_gen:get_inner(InnerType#type.def)) of - Bif when Bif=={primitive,bif};Bif=={constructed,bif} -> - {Bif,InnerType}; - ERef = #'Externaltypereference'{} -> - ERef + Bif when Bif =:= {primitive,bif}; Bif =:= {constructed,bif} -> + #typedef{checked=true,name=Bif,typespec=InnerType}; + #'Externaltypereference'{}=Ref -> + Ref end; - 'ASN1_OPEN_TYPE' -> 'ASN1_OPEN_TYPE' + 'ASN1_OPEN_TYPE' -> + #typedef{checked=true,typespec=T#type{def='ASN1_OPEN_TYPE'}} end. - - - -union_of_defed_objs({_,_,_ObjClass=#type{def=ClassDef},_},ObjFieldSetting) -> - #typedef{typespec=#'ObjectSet'{class = ClassDef, - set = ObjFieldSetting}}; -union_of_defed_objs({_,_,DefObjClassRef,_},ObjFieldSetting) - when is_record(DefObjClassRef,'Externaltypereference') -> - #typedef{typespec=#'ObjectSet'{class = DefObjClassRef, - set = ObjFieldSetting}}. - check_value(OldS,V) when is_record(V,pvaluesetdef) -> #pvaluesetdef{checked=Checked,type=Type} = V, @@ -3046,7 +2903,9 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> Key); _ -> ok end, + Pos = Ext#'Externaltypereference'.pos, {RefType1,#'Externaltypereference'{module=RefMod, + pos=Pos, type=TmpName}} end, @@ -4581,37 +4440,6 @@ get_imported(S,Name,Module,Pos) -> get_renamed_reference(S,Name,Module) end. -check_and_save(S,#'Externaltypereference'{module=M}=ERef,#typedef{checked=false}=TDef,Settings) - when S#state.mname /= M -> - %% This ERef is an imported type (or maybe a set.asn compilation) - NewS = S#state{mname=M,module=load_asn1_module(S,M), - type=TDef,tname=get_datastr_name(TDef)}, - Type=check_type(NewS,TDef,TDef#typedef.typespec),%XXX - CheckedTDef = TDef#typedef{checked=true, - typespec=Type}, - asn1_db:dbput(M,get_datastr_name(TDef),CheckedTDef), - {merged_name(S,ERef),Settings}; -check_and_save(S,#'Externaltypereference'{module=M,type=N}=Eref, - #ptypedef{name=Name,args=Params} = PTDef,Settings) -> - %% instantiate a parameterized type - %% The parameterized type should be saved as a type in the module - %% it was instantiated. - NewS = S#state{mname=M,module=load_asn1_module(S,M), - type=PTDef,tname=Name}, - {Args,RestSettings} = lists:split(length(Params),Settings), - Type = check_type(NewS,PTDef,#type{def={pt,Eref,Args}}), - ERefName = new_reference_name(N), - ERefNew = #'Externaltypereference'{type=ERefName,module=S#state.mname}, - NewTDef=#typedef{checked=true,name=ERefName, - typespec=Type}, - insert_once(S,parameterized_objects,{ERefName,type,NewTDef}), - asn1_db:dbput(S#state.mname,ERefNew#'Externaltypereference'.type, - NewTDef), - {ERefNew,RestSettings}; -check_and_save(_S,ERef,TDef,Settings) -> - %% This might be a renamed type in a set of specs, so rename the ERef - {ERef#'Externaltypereference'{type=asn1ct:get_name_of_def(TDef)},Settings}. - save_object_set_instance(S,Name,ObjSetSpec) when is_record(ObjSetSpec,'ObjectSet') -> NewObjSet = #typedef{checked=true,name=Name,typespec=ObjSetSpec}, @@ -5169,7 +4997,7 @@ expand_components2(S,{_,PT={pt,_,_}}) -> expand_components2(S,{_,OCFT = #'ObjectClassFieldType'{}}) -> UncheckedType = #type{def=OCFT}, Type = check_type(S,#typedef{typespec=UncheckedType},UncheckedType), - expand_components2(S,{undefined,oCFT_def(S,Type)}); + expand_components2(S, {undefined,ocft_def(Type)}); expand_components2(S,{_,ERef}) when is_record(ERef,'Externaltypereference') -> expand_components2(S,get_referenced_type(S,ERef)); expand_components2(_S,Err) -> @@ -6703,6 +6531,14 @@ format_error({missing_mandatory_fields,Fields,Obj}) -> [format_fields(Fields),Obj]); format_error({namelist_redefinition,Name}) -> io_lib:format("the name '~s' can not be redefined", [Name]); +format_error(syntax_nomatch) -> + "unexpected end of object definition"; +format_error({syntax_nomatch,Actual}) -> + io_lib:format("~s is not the next item allowed according to the defined syntax", + [Actual]); +format_error({syntax_undefined_field,Field}) -> + io_lib:format("'&~s' is not a field of the class being defined", + [Field]); format_error({undefined,Name}) -> io_lib:format("'~s' is referenced, but is not defined", [Name]); format_error({undefined_import,Ref,Module}) -> @@ -6931,21 +6767,24 @@ default_type_list() -> ]. -include_default_class(S,Module) -> - NameAbsList = default_class_list(S), - include_default_class1(Module,NameAbsList). +include_default_class(S, Module) -> + _ = [include_default_class1(S, Module, ClassDef) || + ClassDef <- default_class_list(S)], + ok. -include_default_class1(_,[]) -> - ok; -include_default_class1(Module,[{Name,TS}|Rest]) -> - case asn1_db:dbget(Module,Name) of +include_default_class1(S, Module, {Name,Ts0}) -> + case asn1_db:dbget(Module, Name) of undefined -> - C = #classdef{checked=true,module=Module,name=Name, - typespec=TS}, - asn1_db:dbput(Module,Name,C); - _ -> ok - end, - include_default_class1(Module,Rest). + #objectclass{fields=Fields, + syntax={'WITH SYNTAX',Syntax0}} = Ts0, + Syntax = preprocess_syntax(S, Syntax0, Fields), + Ts = Ts0#objectclass{syntax={preprocessed_syntax,Syntax}}, + C = #classdef{checked=true,module=Module, + name=Name,typespec=Ts}, + asn1_db:dbput(Module, Name, C); + _ -> + ok + end. default_class_list(S) -> [{'TYPE-IDENTIFIER', -- cgit v1.2.3 From 369aebd67933c8f45cdd5feec360aace190ef019 Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Tue, 16 Sep 2014 12:55:25 +0200 Subject: asn1: Fix BER generation for non optional and extended object sets Object sets with extension mark and without optional fields was not generated properly. It needs the default [enc|dec]_xxx function clause for the open type but no other clauses. --- lib/asn1/src/asn1ct_gen_ber_bin_v2.erl | 50 ++++++++++++++++++++-------------- 1 file changed, 30 insertions(+), 20 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl index e51b0898be..41f86046f0 100644 --- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2013. All Rights Reserved. +%% Copyright Ericsson AB 2002-2014. 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 @@ -1179,23 +1179,25 @@ gen_objset_enc(_,_,{unique,undefined},_,_,_,_,_) -> gen_objset_enc(Erules, ObjSetName, UniqueName, [{ObjName,Val,Fields}|T], ClName, ClFields, NthObj,Acc)-> - emit(["'getenc_",ObjSetName,"'(",{asis,Val},") ->",nl]), CurrMod = get(currmod), {InternalFunc,NewNthObj}= case ObjName of {no_mod,no_name} -> - gen_inlined_enc_funs(Fields,ClFields,ObjSetName,NthObj); + gen_inlined_enc_funs(Fields, ClFields, ObjSetName, Val, NthObj); {CurrMod,Name} -> - emit({" fun 'enc_",Name,"'/3"}), + emit(["'getenc_",ObjSetName,"'(",{asis,Val},") ->",nl, + " fun 'enc_",Name,"'/3;",nl]), {[],NthObj}; {ModuleName,Name} -> + emit(["'getenc_",ObjSetName,"'(",{asis,Val},") ->",nl]), emit_ext_fun(enc,ModuleName,Name), + emit([";",nl]), {[],NthObj}; _ -> - emit({" fun 'enc_",ObjName,"'/3"}), + emit(["'getenc_",ObjSetName,"'(",{asis,Val},") ->",nl, + " fun 'enc_",ObjName,"'/3;",nl]), {[],NthObj} end, - emit({";",nl}), gen_objset_enc(Erules, ObjSetName, UniqueName, T, ClName, ClFields, NewNthObj, InternalFunc ++ Acc); %% See X.681 Annex E for the following case @@ -1223,13 +1225,14 @@ emit_default_getenc(ObjSetName,UniqueName) -> %% gen_inlined_enc_funs for each object iterates over all fields of a %% class, and for each typefield it checks if the object has that %% field and emits the proper code. -gen_inlined_enc_funs(Fields, [{typefield,_,_}|_]=T, ObjSetName, NthObj) -> - emit([indent(3),"fun(Type, Val, _RestPrimFieldName) ->",nl, +gen_inlined_enc_funs(Fields, [{typefield,_,_}|_]=T, ObjSetName, Val, NthObj) -> + emit(["'getenc_",ObjSetName,"'(",{asis,Val},") ->",nl, + indent(3),"fun(Type, Val, _RestPrimFieldName) ->",nl, indent(6),"case Type of",nl]), gen_inlined_enc_funs1(Fields, T, ObjSetName, [], NthObj, []); -gen_inlined_enc_funs(Fields,[_|Rest],ObjSetName,NthObj) -> - gen_inlined_enc_funs(Fields,Rest,ObjSetName,NthObj); -gen_inlined_enc_funs(_,[],_,NthObj) -> +gen_inlined_enc_funs(Fields, [_|Rest], ObjSetName, Val, NthObj) -> + gen_inlined_enc_funs(Fields, Rest, ObjSetName, Val, NthObj); +gen_inlined_enc_funs(_, [], _, _, NthObj) -> {[],NthObj}. gen_inlined_enc_funs1(Fields, [{typefield,Name,_}|Rest], ObjSetName, @@ -1276,7 +1279,7 @@ gen_inlined_enc_funs1(Fields,[_|Rest], ObjSetName, Sep, NthObj, Acc)-> gen_inlined_enc_funs1(Fields, Rest, ObjSetName, Sep, NthObj, Acc); gen_inlined_enc_funs1(_, [], _, _, NthObj, Acc) -> emit([nl,indent(6),"end",nl, - indent(3),"end"]), + indent(3),"end;",nl]), {Acc,NthObj}. emit_enc_open_type(I) -> @@ -1358,23 +1361,25 @@ gen_objset_dec(_,_,{unique,undefined},_,_,_,_) -> ok; gen_objset_dec(Erules, ObjSName, UniqueName, [{ObjName,Val,Fields}|T], ClName, ClFields, NthObj)-> - emit(["'getdec_",ObjSName,"'(",{asis,Val},") ->",nl]), CurrMod = get(currmod), NewNthObj= case ObjName of {no_mod,no_name} -> - gen_inlined_dec_funs(Fields,ClFields,ObjSName,NthObj); + gen_inlined_dec_funs(Fields,ClFields,ObjSName,Val,NthObj); {CurrMod,Name} -> - emit([" fun 'dec_",Name,"'/3"]), + emit(["'getdec_",ObjSName,"'(",{asis,Val},") ->",nl, + " fun 'dec_",Name,"'/3;", nl]), NthObj; {ModuleName,Name} -> + emit(["'getdec_",ObjSName,"'(",{asis,Val},") ->",nl]), emit_ext_fun(dec,ModuleName,Name), + emit([";",nl]), NthObj; _ -> - emit([" fun 'dec_",ObjName,"'/3"]), + emit(["'getdec_",ObjSName,"'(",{asis,Val},") ->",nl, + " fun 'dec_",ObjName,"'/3;", nl]), NthObj end, - emit([";",nl]), gen_objset_dec(Erules, ObjSName, UniqueName, T, ClName, ClFields, NewNthObj); gen_objset_dec(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, @@ -1394,10 +1399,15 @@ emit_default_getdec(ObjSetName,UniqueName) -> emit(["'getdec_",ObjSetName,"'(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, ClFields, ObjSetName, NthObj) -> +gen_inlined_dec_funs(Fields, [{typefield,_,_}|_]=ClFields, ObjSetName, Val, NthObj) -> + emit(["'getdec_",ObjSetName,"'(",{asis,Val},") ->",nl]), emit([indent(3),"fun(Type, Bytes, _RestPrimFieldName) ->",nl, indent(6),"case Type of",nl]), - gen_inlined_dec_funs1(Fields, ClFields, ObjSetName, "", NthObj). + gen_inlined_dec_funs1(Fields, ClFields, ObjSetName, "", NthObj); +gen_inlined_dec_funs(Fields, [_|ClFields], ObjSetName, Val, NthObj) -> + gen_inlined_dec_funs(Fields, ClFields, ObjSetName, Val, NthObj); +gen_inlined_dec_funs(_, _, _, _,NthObj) -> + NthObj. gen_inlined_dec_funs1(Fields, [{typefield,Name,Prop}|Rest], ObjSetName, Sep0, NthObj) -> @@ -1439,7 +1449,7 @@ gen_inlined_dec_funs1(Fields, [_|Rest], ObjSetName, Sep, NthObj)-> gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj); gen_inlined_dec_funs1(_, [], _, _, NthObj) -> emit([nl,indent(6),"end",nl, - indent(3),"end"]), + indent(3),"end;",nl]), NthObj. emit_dec_open_type(I) -> -- cgit v1.2.3 From 6b10f918a4445d990152e4a31f8fde5cc9c8906a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 9 Oct 2014 12:44:48 +0200 Subject: Provide more reliable location of errors File names and line number information was not reliable available when producing error messages. Some items have embedded line number information, and sometimes the S#state.type and/or S#state.value could be used to retrieve the line number information. To make sure that we can always retrieve at least an approximate error location, store the top-level construct being checked in S#state.error_context. Example of top-level constructs: Seq ::= SEQUENCE {...} i INTEGER ::= 42 This is a short-term solution. In the long term, we would want the parser to include line number information in all items. --- lib/asn1/src/asn1_records.hrl | 19 +++++++++-- lib/asn1/src/asn1ct_check.erl | 74 +++++++++++++++++++++++-------------------- 2 files changed, 55 insertions(+), 38 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1_records.hrl b/lib/asn1/src/asn1_records.hrl index 6c1cf1b12a..24f4eabe38 100644 --- a/lib/asn1/src/asn1_records.hrl +++ b/lib/asn1/src/asn1_records.hrl @@ -81,9 +81,22 @@ module :: atom(), val :: atom()}). --record(state,{module,mname,type,tname,value,vname,erule,parameters=[], - inputmodules,abscomppath=[],recordtopname=[],options, - sourcedir}). +-record(state, + {module, + mname, + type, + tname, + value, + vname, + erule, + parameters=[], + inputmodules, + abscomppath=[], + recordtopname=[], + options, + sourcedir, + error_context %Top-level thingie (contains line numbers) + }). %% state record used by back-end at partial decode %% active is set to 'yes' when a partial decode function is generated. diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 14ffc61068..e1607260df 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -441,7 +441,7 @@ checkc(S, Names) -> do_checkc(S, Name, Class) -> case is_classname(Name) of false -> - return_asn1_error(S, Class, {illegal_class_name,Name}); + return_asn1_error(S, {illegal_class_name,Name}); true -> do_checkc_1(S, Name, Class) end. @@ -473,12 +473,11 @@ is_classname(Name) when is_atom(Name) -> (_) -> false end, atom_to_list(Name)). -checko(S,[Name|Os],Acc,ExclO,ExclOS) -> - ?dbg("Checking object ~p~n",[Name]), +checko(S0,[Name|Os],Acc,ExclO,ExclOS) -> + Item = asn1_db:dbget(S0#state.mname, Name), + S = S0#state{error_context=Item}, Result = - case asn1_db:dbget(S#state.mname,Name) of - undefined -> - error({type,{internal_error,'???'},S}); + case Item of Object when is_record(Object,typedef) -> NewS = S#state{type=Object,tname=Name}, case catch(check_object(NewS,Object,Object#typedef.typespec)) of @@ -1154,7 +1153,7 @@ check_object_list(S,ClassRef,[ObjOrSet|Objs],Acc) -> check_object_list(S, ClassRef, Objs, [{{no_mod,no_name},Def}|Acc]); _ -> - asn1_error(S, S#state.type, illegal_object) + asn1_error(S, illegal_object) end; ObjSet when is_record(ObjSet,type) -> ObjSetDef = @@ -1262,7 +1261,7 @@ get_value_from_object(S, Def, FieldNames) -> #valuedef{value=Val} -> Val; _ -> - asn1_error(S, Def, illegal_value) + asn1_error(S, illegal_value) end. %% extract_field(State, ObjectOrObjectSet, [{RefType,FieldName}]) @@ -1613,14 +1612,14 @@ preprocess_syntax(S, [{valuefieldreference,Name}|T], Cs) -> Tuple when is_tuple(Tuple) -> [{field,Tuple}|preprocess_syntax(S, T, Cs)]; false -> - asn1_error(S, S#state.type, {syntax_undefined_field,Name}) + asn1_error(S, {syntax_undefined_field,Name}) end; preprocess_syntax(S, [{typefieldreference,Name}|T], Cs) -> case lists:keyfind(Name, 2, Cs) of Tuple when is_tuple(Tuple) -> [{field,Tuple}|preprocess_syntax(S, T, Cs)]; false -> - asn1_error(S, S#state.type, {syntax_undefined_field,Name}) + asn1_error(S, {syntax_undefined_field,Name}) end; preprocess_syntax(S,[{Token,_}|T], Cs) when is_atom(Token) -> [{token,Token}|preprocess_syntax(S, T, Cs)]; @@ -1830,12 +1829,12 @@ match_syntax_objset_1(_, #type{def=#'ObjectClassFieldType'{}}=Set, ClassDef) -> make_objset(ClassDef, Set) -> #typedef{typespec=#'ObjectSet'{class=ClassDef,set=Set}}. -syntax_match_error(#state{type=Type}=S) -> - asn1_error(S, Type, syntax_nomatch). +syntax_match_error(S) -> + asn1_error(S, syntax_nomatch). -syntax_match_error(#state{type=Type}=S, What0) -> +syntax_match_error(S, What0) -> What = printable_string(What0), - asn1_error(S, Type, {syntax_nomatch,What}). + asn1_error(S, {syntax_nomatch,What}). printable_string(Def) -> printable_string_1(Def). @@ -1874,18 +1873,18 @@ check_defaultfields(S, Fields, ClassFields) -> Mandatory0 = get_mandatory_class_fields(ClassFields), Mandatory = ordsets:from_list(Mandatory0), All = ordsets:from_list([element(2, F) || F <- ClassFields]), - #state{type=T,tname=Obj} = S, + #state{tname=Obj} = S, case ordsets:subtract(Present, All) of [] -> ok; [_|_]=Invalid -> - asn1_error(S, T, {invalid_fields,Invalid,Obj}) + asn1_error(S, {invalid_fields,Invalid,Obj}) end, case ordsets:subtract(Mandatory, Present) of [] -> check_defaultfields_1(S, Fields, ClassFields, []); [_|_]=Missing -> - asn1_error(S, T, {missing_mandatory_fields,Missing,Obj}) + asn1_error(S, {missing_mandatory_fields,Missing,Obj}) end. check_defaultfields_1(_S, [], _ClassFields, Acc) -> @@ -2367,10 +2366,10 @@ normalize_integer(S, #'Externalvaluereference'{value=Name}=Ref, NNL) -> Val when is_integer(Val) -> Val; _ -> - asn1_error(S, S#state.value, illegal_integer_value) + asn1_error(S, illegal_integer_value) catch throw:_ -> - asn1_error(S, S#state.value, illegal_integer_value) + asn1_error(S, illegal_integer_value) end end; normalize_integer(S, {'ValueFromObject',{object,Obj},FieldNames}, _) -> @@ -2378,10 +2377,10 @@ normalize_integer(S, {'ValueFromObject',{object,Obj},FieldNames}, _) -> #valuedef{value=Val} when is_integer(Val) -> Val; _ -> - asn1_error(S, S#state.value, illegal_integer_value) + asn1_error(S, illegal_integer_value) end; -normalize_integer(#state{value=Val}=S, _, _) -> - asn1_error(S, Val, illegal_integer_value). +normalize_integer(S, _, _) -> + asn1_error(S, illegal_integer_value). %% normalize_bitstring(S, Value, Type) -> bitstring() %% Convert a literal value for a BIT STRING to an Erlang bit string. @@ -2462,8 +2461,7 @@ normalize_octetstring(S,Value,CType) -> {Name,String} when is_atom(Name) -> normalize_octetstring(S,String,CType); _ -> - Item = S#state.value, - asn1_error(S, Item, illegal_octet_string_value) + asn1_error(S, illegal_octet_string_value) end. normalize_objectidentifier(S, Value) -> @@ -2816,8 +2814,8 @@ check_formal_parameter(_, {_,_}) -> ok; check_formal_parameter(_, #'Externaltypereference'{}) -> ok; -check_formal_parameter(S, #'Externalvaluereference'{value=Name}=Ref) -> - asn1_error(S, Ref, {illegal_typereference,Name}). +check_formal_parameter(S, #'Externalvaluereference'{value=Name}) -> + asn1_error(S, {illegal_typereference,Name}). % check_type(S,Type,ObjSpec={{objectclassname,_},_}) -> % check_class(S,ObjSpec); @@ -3588,14 +3586,14 @@ resolv_value1(S, {gt,V}) -> Int when is_integer(Int) -> Int + 1; _Other -> - asn1_error(S, S#state.type, illegal_integer_value) + asn1_error(S, illegal_integer_value) end; resolv_value1(S, {lt,V}) -> case resolv_value1(S, V) of Int when is_integer(Int) -> Int - 1; _Other -> - asn1_error(S, S#state.type, illegal_integer_value) + asn1_error(S, illegal_integer_value) end; resolv_value1(S, {'ValueFromObject',{object,Object},FieldName}) -> get_value_from_object(S, Object, FieldName); @@ -4652,7 +4650,6 @@ check_named_number_list(_S, [{_,_}|_]=NNL) -> NNL; check_named_number_list(S, NNL0) -> %% Check that the names are unique. - T = S#state.type, case check_unique(NNL0, 2) of [] -> NNL1 = [{Id,resolve_valueref(S, Val)} || {'NamedNumber',Id,Val} <- NNL0], @@ -4661,10 +4658,10 @@ check_named_number_list(S, NNL0) -> [] -> NNL; [Val|_] -> - asn1_error(S, T, {value_reused,Val}) + asn1_error(S, {value_reused,Val}) end; [H|_] -> - asn1_error(S, T, {namelist_redefinition,H}) + asn1_error(S, {namelist_redefinition,H}) end. resolve_valueref(S, #'Externalvaluereference'{module=Mod,value=Name}) -> @@ -4677,7 +4674,7 @@ check_integer(S, NNL) -> check_bitstring(S, NNL0) -> NNL = check_named_number_list(S, NNL0), - _ = [asn1_error(S, S#state.type, {invalid_bit_number,Bit}) || + _ = [asn1_error(S, {invalid_bit_number,Bit}) || {_,Bit} <- NNL, Bit < 0], NNL. @@ -4702,7 +4699,7 @@ check_type_identifier(S, Eref=#'Externaltypereference'{type=Class}) -> {_,TD=#typedef{typespec=#type{def=#'Externaltypereference'{}}}} -> check_type_identifier(S, (TD#typedef.typespec)#type.def); _ -> - asn1_error(S, S#state.type, {illegal_instance_of,Class}) + asn1_error(S, {illegal_instance_of,Class}) end. iof_associated_type(S,[]) -> @@ -6496,10 +6493,16 @@ findtypes_and_values([],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) -> {lists:reverse(Tacc),lists:reverse(Vacc),lists:reverse(Pacc), lists:reverse(Cacc),lists:reverse(Oacc),lists:reverse(OSacc)}. +return_asn1_error(#state{error_context=Context}=S, Error) -> + return_asn1_error(S, Context, Error). + return_asn1_error(#state{mname=Where}, Item, Error) -> Pos = asn1ct:get_pos_of_def(Item), {structured_error,{Where,Pos},?MODULE,Error}. +asn1_error(S, Error) -> + throw({error,return_asn1_error(S, Error)}). + asn1_error(S, Item, Error) -> throw({error,return_asn1_error(S, Item, Error)}). @@ -6851,8 +6854,9 @@ insert_once(S,Tab,Key) -> skipped end. -check_fold(S, [H|T], Check) -> - Type = asn1_db:dbget(S#state.mname, H), +check_fold(S0, [H|T], Check) -> + Type = asn1_db:dbget(S0#state.mname, H), + S = S0#state{error_context=Type}, case Check(S, H, Type) of ok -> check_fold(S, T, Check); -- cgit v1.2.3 From 2ae4e110b687b31aaa9a0e2d06b0e019819ab753 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 22 Sep 2014 14:22:50 +0200 Subject: Clean up get_fieldname_element/3 Also add proper error handling. --- lib/asn1/src/asn1ct_check.erl | 80 +++++++++++++++++++++++-------------------- 1 file changed, 42 insertions(+), 38 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index e1607260df..30ec0c2aac 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -1260,6 +1260,8 @@ get_value_from_object(S, Def, FieldNames) -> case extract_field(S, Def, FieldNames) of #valuedef{value=Val} -> Val; + {valueset,_}=Val -> + Val; _ -> asn1_error(S, illegal_value) end. @@ -1286,43 +1288,44 @@ extract_field(S, Def0, FieldNames) -> %% All field names but the last refers to either an object or object set. get_fieldname_element(S, #typedef{}=Def, [{_RefType,FieldName}]) -> - {_,_,ObjComps} = (Def#typedef.typespec)#'Object'.def, - check_fieldname_element(S,lists:keysearch(FieldName,1,ObjComps)); -get_fieldname_element(S,Def,[{_RefType,FieldName}|Rest]) - when is_record(Def,typedef) -> - %% As FieldName is followd by other FieldNames it has to be an + Object = (Def#typedef.typespec)#'Object'.def, + check_fieldname_element(S, FieldName, Object); +get_fieldname_element(S, #typedef{}=Def, [{_RefType,FieldName}|T]) -> + %% As FieldName is followed by other FieldNames it has to be an %% object or objectset. - {_,_,ObjComps} = (Def#typedef.typespec)#'Object'.def, - NewDef = check_fieldname_element(S,lists:keysearch(FieldName,1,ObjComps)), - ObjDef = fun(#'Object'{def=D}) -> D; - (#'ObjectSet'{set=Set}) -> Set - end - (NewDef), - case ObjDef of - L when is_list(L) -> - [get_fieldname_element(S,X,Rest) || X <- L]; - _ -> - get_fieldname_element(S,ObjDef,Rest) + Object = (Def#typedef.typespec)#'Object'.def, + case check_fieldname_element(S, FieldName, Object) of + #'Object'{def=D} -> + get_fieldname_element(S, D, T); + #'ObjectSet'{set=Set0} -> + Set = [get_fieldname_element(S, X, T) || X <- Set0], + get_fieldname_return_set(Set) end; -get_fieldname_element(S,{object,_,Fields},[{_RefType,FieldName}|Rest]) -> - NewDef = check_fieldname_element(S,lists:keysearch(FieldName,1,Fields)), - get_fieldname_element(S,NewDef,Rest); -get_fieldname_element(_S,Def,[]) -> - Def; -get_fieldname_element(_S,Def,[{_RefType,_FieldName}|_RestFName]) - when is_record(Def,typedef) -> - ok. +get_fieldname_element(S, {_,_,_}=Object, [{_RefType,FieldName}|T]) -> + Def = check_fieldname_element(S, FieldName, Object), + get_fieldname_element(S, Def, T); +get_fieldname_element(_S, Def, []) -> + Def. + +get_fieldname_return_set([#valuedef{}|_]=L) -> + {valueset,L}. + +check_fieldname_element(S, Name, {_,_,Fields}) -> + case lists:keyfind(Name, 1, Fields) of + {Name,Def} -> + check_fieldname_element_1(S, Def); + false -> + asn1_error(S, {undefined_field,Name}) + end. -check_fieldname_element(S,{value,{_,Def}}) -> - check_fieldname_element(S,Def); -check_fieldname_element(S, #typedef{typespec=Ts}=TDef) -> +check_fieldname_element_1(S, #typedef{typespec=Ts}=TDef) -> case Ts of #'Object'{} -> check_object(S, TDef, Ts); _ -> check_type(S, TDef, Ts) end; -check_fieldname_element(S, #valuedef{}=VDef) -> +check_fieldname_element_1(S, #valuedef{}=VDef) -> try check_value(S, VDef) catch @@ -1332,17 +1335,15 @@ check_fieldname_element(S, #valuedef{}=VDef) -> ClassName = Type#type.def, NewSpec = #'Object'{classname=ClassName,def=Def}, NewDef = #typedef{checked=C,pos=Pos,name=N,typespec=NewSpec}, - check_fieldname_element(S, NewDef) + check_fieldname_element_1(S, NewDef) end; -check_fieldname_element(_S, {value_tag,Val}) -> +check_fieldname_element_1(_S, {value_tag,Val}) -> #valuedef{value=Val}; -check_fieldname_element(S,Eref) - when is_record(Eref,'Externaltypereference'); - is_record(Eref,'Externalvaluereference') -> - {_,TDef}=get_referenced_type(S,Eref), - check_fieldname_element(S,TDef); -check_fieldname_element(S,Other) -> - throw({error,{assigned_object_error,"not_assigned_object",Other,S}}). +check_fieldname_element_1(S, Eref) + when is_record(Eref, 'Externaltypereference'); + is_record(Eref, 'Externalvaluereference') -> + {_,TDef} = get_referenced_type(S, Eref), + check_fieldname_element_1(S, TDef). transform_set_to_object_list([{Name,_UVal,Fields}|Objs],Acc) -> transform_set_to_object_list(Objs,[{Name,{object,generatesyntax,Fields}}|Acc]); @@ -2372,7 +2373,8 @@ normalize_integer(S, #'Externalvaluereference'{value=Name}=Ref, NNL) -> asn1_error(S, illegal_integer_value) end end; -normalize_integer(S, {'ValueFromObject',{object,Obj},FieldNames}, _) -> +normalize_integer(S0, {'ValueFromObject',{object,Obj},FieldNames}, _) -> + S = S0#state{type=S0#state.value}, case extract_field(S, Obj, FieldNames) of #valuedef{value=Val} when is_integer(Val) -> Val; @@ -6544,6 +6546,8 @@ format_error({syntax_undefined_field,Field}) -> [Field]); format_error({undefined,Name}) -> io_lib:format("'~s' is referenced, but is not defined", [Name]); +format_error({undefined_field,FieldName}) -> + io_lib:format("the field '&~s' is undefined", [FieldName]); format_error({undefined_import,Ref,Module}) -> io_lib:format("'~s' is not exported from ~s", [Ref,Module]); format_error({value_reused,Val}) -> -- cgit v1.2.3 From 3ab3b07afd07bb2fc59037e4b65f08c9038bf078 Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Thu, 18 Sep 2014 16:40:29 +0200 Subject: Fix BER code generation PKIX1Explicit-2009 did not compile. --- lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl index 5fadd0495a..820d19b85c 100644 --- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2013. All Rights Reserved. +%% Copyright Ericsson AB 2002-2014. 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 @@ -234,7 +234,7 @@ gen_decode_sequence(Erules,Typename,D) when is_record(D,type) -> asn1ct_name:new(rb), emit([" {'",RecordName,"'}.",nl,nl]); {LeadingAttrTerm,PostponedDecArgs} -> - emit([com,nl,nl]), + emit([nl]), case {LeadingAttrTerm,PostponedDecArgs} of {[],[]} -> ok; @@ -413,7 +413,7 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) -> %% return value as record emit([" {'",RecordName,"'}.",nl]); {LeadingAttrTerm,PostponedDecArgs} -> - emit([com,nl,nl]), + emit([nl]), case {LeadingAttrTerm,PostponedDecArgs} of {[],[]} -> ok; @@ -617,18 +617,20 @@ gen_dec_sequence_call1(Erules,TopType,[#'ComponentType'{name=Cname,typespec=Type {LA,PostponedDec} = gen_dec_component(Erules,TopType,Cname,Tags,Type,Num,Prop, Ext,DecObjInf), + emit([com,nl]), case Rest of [] -> {LA ++ LeadingAttrAcc,PostponedDec ++ ArgsAcc}; _ -> - emit([com,nl]), asn1ct_name:new(bytes), gen_dec_sequence_call1(Erules,TopType,Rest,Num+1,Ext,DecObjInf, LA++LeadingAttrAcc,PostponedDec++ArgsAcc) end; gen_dec_sequence_call1(_Erules,_TopType,[],1,_,_,_,_) -> - no_terms. + no_terms; +gen_dec_sequence_call1(_, _, [], _Num, _, _, LA, PostponedDec) -> + {LA, PostponedDec}. gen_dec_sequence_call2(_Erules,_TopType, {[], [], []}, _Ext,_DecObjInf) -> no_terms; @@ -643,7 +645,6 @@ gen_dec_sequence_call2(Erules,TopType,{Root1,EList,Root2},_Ext,DecObjInf) -> %% TagList is the tags of Root2 elements from the first up to and %% including the first mandatory element. TagList = get_root2_taglist(Root2,[]), - emit({com,nl}), emit([{curr,tlv}," = ", {call,ber,skip_ExtensionAdditions, [{prev,tlv},{asis,TagList}]},com,nl]), -- cgit v1.2.3 From 081b4f03af69f67abf97f268d5d097918a6f3d6d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 25 Sep 2014 12:53:56 +0200 Subject: Correct recursion in OCTET STRING value definitions --- lib/asn1/src/asn1ct_check.erl | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 30ec0c2aac..cc03cd68fe 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2308,8 +2308,8 @@ normalize_value(S0, Type, {'DEFAULT',Value}, NameList) -> normalize_integer(S0, Value, CType); {'BIT STRING',CType,_} -> normalize_bitstring(S,Value,CType); - {'OCTET STRING',CType,_} -> - normalize_octetstring(S0, Value, CType); + {'OCTET STRING',_,_} -> + normalize_octetstring(S0, Value); {'NULL',_CType,_} -> %%normalize_null(Value); 'NULL'; @@ -2451,17 +2451,26 @@ hex_to_int(D) when $A =< D, D =< $F -> D - ($A - 10). %% {bstring,String} each element in String corresponds to one bit in an octet %% {hstring,String} each element in String corresponds to one byte in an octet %% #'Externalvaluereference' -normalize_octetstring(S,Value,CType) -> +normalize_octetstring(S, Value) -> case Value of {bstring,String} -> bstring_to_binary(String); {hstring,String} -> hstring_to_binary(String); - Rec when is_record(Rec,'Externalvaluereference') -> - get_normalized_value(S,Value,CType, - fun normalize_octetstring/3,[]); - {Name,String} when is_atom(Name) -> - normalize_octetstring(S,String,CType); + #'Externalvaluereference'{} -> + case get_referenced_value(S, Value) of + String when is_binary(String) -> + String; + Other -> + normalize_octetstring(S, Other) + end; + {'ValueFromObject',{object,Obj},FieldNames} -> + case extract_field(S, Obj, FieldNames) of + #valuedef{value=Val} when is_binary(Val) -> + Val; + _ -> + asn1_error(S, illegal_octet_string_value) + end; _ -> asn1_error(S, illegal_octet_string_value) end. -- cgit v1.2.3 From bb97d8be44455847bc4186fc57a9c9af81b765fa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 16 Oct 2014 14:22:52 +0200 Subject: Clean up use of asn1ct_gen:gen_types() asn1ct_gen:gen_types/3 is called by gen_encode_constructed/4 and generates encode *and* decode functions for any nested types. To faciliate future rewriting, where we might want to tweak code generation for encode and decode separately, refactor the code so that gen_encode_constructed/4 will only encode functions for nested types, and gen_deccode_constructed/4 will generate decode functions for nested types. --- lib/asn1/src/asn1ct_gen.erl | 75 ++++++++++++++++++++++++--------------------- 1 file changed, 40 insertions(+), 35 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 450d309688..d3c1f34821 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -531,34 +531,30 @@ 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}}}). - -gen_types(Erules,Tname,{RootL1,ExtList,RootL2}) +%% EncDec = 'gen_encode' | 'gen_decode' +gen_types(Erules, Tname, {RootL1,ExtList,RootL2}, EncDec) when is_list(RootL1), is_list(RootL2) -> - gen_types(Erules,Tname,RootL1), - Rtmod = ct_gen_module(Erules), - gen_types(Erules,Tname,Rtmod: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, RootL1, EncDec), Rtmod = ct_gen_module(Erules), - gen_types(Erules,Tname,Rtmod:extaddgroup2sequence(ExtList)); -gen_types(Erules,Tname,[{'EXTENSIONMARK',_,_}|Rest]) -> - gen_types(Erules,Tname,Rest); -gen_types(Erules,Tname,[ComponentType|Rest]) -> + gen_types(Erules, Tname, Rtmod:extaddgroup2sequence(ExtList), EncDec), + gen_types(Erules, Tname, RootL2, EncDec); +gen_types(Erules, Tname, {RootList,ExtList}, EncDec) when is_list(RootList) -> + gen_types(Erules, Tname, RootList, EncDec), Rtmod = ct_gen_module(Erules), + gen_types(Erules, Tname, Rtmod:extaddgroup2sequence(ExtList), EncDec); +gen_types(Erules, Tname, [{'EXTENSIONMARK',_,_}|T], EncDec) -> + gen_types(Erules, Tname, T, EncDec); +gen_types(Erules, Tname, [ComponentType|T], EncDec) -> asn1ct_name:clear(), - Rtmod:gen_encode(Erules,Tname,ComponentType), - asn1ct_name:clear(), - Rtmod:gen_decode(Erules,Tname,ComponentType), - gen_types(Erules,Tname,Rest); -gen_types(_,_,[]) -> - true; -gen_types(Erules,Tname,Type) when is_record(Type,type) -> Rtmod = ct_gen_module(Erules), + Rtmod:EncDec(Erules, Tname, ComponentType), + gen_types(Erules, Tname, T, EncDec); +gen_types(_, _, [], _) -> + ok; +gen_types(Erules, Tname, #type{}=Type, EncDec) -> asn1ct_name:clear(), - Rtmod:gen_encode(Erules,Tname,Type), - asn1ct_name:clear(), - Rtmod:gen_decode(Erules,Tname,Type). + Rtmod = ct_gen_module(Erules), + Rtmod:EncDec(Erules, Tname, Type). %% VARIOUS GENERATOR STUFF %% ************************************************* @@ -599,25 +595,25 @@ gen_encode_constructed(Erules,Typename,InnerType,D) when is_record(D,type) -> 'SET' -> Rtmod:gen_encode_set(Erules,Typename,D), #'SET'{components=Components} = D#type.def, - gen_types(Erules,Typename,Components); + gen_types(Erules, Typename, Components, gen_encode); 'SEQUENCE' -> Rtmod:gen_encode_sequence(Erules,Typename,D), #'SEQUENCE'{components=Components} = D#type.def, - gen_types(Erules,Typename,Components); + gen_types(Erules, Typename, Components, gen_encode); 'CHOICE' -> Rtmod:gen_encode_choice(Erules,Typename,D), {_,Components} = D#type.def, - gen_types(Erules,Typename,Components); + gen_types(Erules, Typename, Components, gen_encode); 'SEQUENCE OF' -> Rtmod:gen_encode_sof(Erules,Typename,InnerType,D), {_,Type} = D#type.def, NameSuffix = asn1ct_gen:constructed_suffix(InnerType,Type#type.def), - gen_types(Erules,[NameSuffix|Typename],Type); + gen_types(Erules, [NameSuffix|Typename], Type, gen_encode); 'SET OF' -> Rtmod:gen_encode_sof(Erules,Typename,InnerType,D), {_,Type} = D#type.def, NameSuffix = asn1ct_gen:constructed_suffix(InnerType,Type#type.def), - gen_types(Erules,[NameSuffix|Typename],Type); + gen_types(Erules, [NameSuffix|Typename], Type, gen_encode); _ -> exit({nyi,InnerType}) end; @@ -630,20 +626,29 @@ gen_decode_constructed(Erules,Typename,InnerType,D) when is_record(D,type) -> asn1ct:step_in_constructed(), %% updates namelist for exclusive decode case InnerType of 'SET' -> - Rtmod:gen_decode_set(Erules,Typename,D); + Rtmod:gen_decode_set(Erules,Typename,D), + #'SET'{components=Components} = D#type.def, + gen_types(Erules, Typename, Components, gen_decode); 'SEQUENCE' -> - Rtmod:gen_decode_sequence(Erules,Typename,D); + Rtmod:gen_decode_sequence(Erules,Typename,D), + #'SEQUENCE'{components=Components} = D#type.def, + gen_types(Erules, Typename, Components, gen_decode); 'CHOICE' -> - Rtmod:gen_decode_choice(Erules,Typename,D); + Rtmod:gen_decode_choice(Erules,Typename,D), + {_,Components} = D#type.def, + gen_types(Erules, Typename, Components, gen_decode); 'SEQUENCE OF' -> - Rtmod:gen_decode_sof(Erules,Typename,InnerType,D); + Rtmod:gen_decode_sof(Erules,Typename,InnerType,D), + {_,#type{def=Def}=Type} = D#type.def, + NameSuffix = asn1ct_gen:constructed_suffix(InnerType, Def), + gen_types(Erules, [NameSuffix|Typename], Type, gen_decode); 'SET OF' -> - Rtmod:gen_decode_sof(Erules,Typename,InnerType,D); - _ -> - exit({nyi,InnerType}) + Rtmod:gen_decode_sof(Erules,Typename,InnerType,D), + {_,#type{def=Def}=Type} = D#type.def, + NameSuffix = asn1ct_gen:constructed_suffix(InnerType, Def), + gen_types(Erules, [NameSuffix|Typename], Type, gen_decode) end; - gen_decode_constructed(Erules,Typename,InnerType,D) when is_record(D,typedef) -> gen_decode_constructed(Erules,Typename,InnerType,D#typedef.typespec). -- cgit v1.2.3 From 07ecfe45e8c22c1d8bde26a39aa833ac6901c348 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 14 Oct 2014 10:47:58 +0200 Subject: per/uper: Fix code generation for nested types in objects --- lib/asn1/src/asn1ct_constructed_per.erl | 134 +++++++++++++++----------------- 1 file changed, 63 insertions(+), 71 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl index a91404ed54..83c0acae17 100644 --- a/lib/asn1/src/asn1ct_constructed_per.erl +++ b/lib/asn1/src/asn1ct_constructed_per.erl @@ -410,12 +410,11 @@ gen_dec_open_type(Erule, Val, {Xmod,Xtype}, LeadingAttr, #classdef{typespec=ClassDef} = asn1_db:dbget(ClMod, ClType), #objectclass{fields=ClassFields} = ClassDef, Extensible = lists:member('EXTENSIONMARK', ObjSet1), - ObjSet2 = [{Key,fix_object_code(Name, Code, ClassFields)} || - {_,Key,Code} <- ObjSet1], - ObjSet = lists:sort([P || {_,B}=P <- ObjSet2, B =/= none]), + Typename = [Name,ClType], + ObjSet = index_object_set(Erule, ClType, Name, + ObjSet1, ClassFields), Key = erlang:md5(term_to_binary({decode,ObjSet,RestFieldNames, Prop,Extensible})), - Typename = [Name,ClType], Gen = fun(_Fd, N) -> dec_objset_optional(N, Prop), dec_objset(Erule, N, ObjSet, RestFieldNames, Typename), @@ -467,46 +466,15 @@ dec_objset_2(Erule, Obj, RestFields0, Typename) -> Imm = asn1ct_gen_per:gen_dec_imm(Erule, Type), {Term,_} = asn1ct_imm:dec_slim_cg(Imm, 'Bytes'), emit([com,nl,Term]); - #typedef{name={constructed,bif},typespec=Def} -> - InnerType = asn1ct_gen:get_inner(Def#type.def), - case InnerType of - 'CHOICE' -> - asn1ct_name:start(), - asn1ct_name:new(bytes), - {'CHOICE',CompList} = Def#type.def, - Ext = extensible_enc(CompList), - emit(["{Result,_} = begin",nl]), - gen_dec_choice(Erule, Typename, CompList, Ext), - emit([nl, - "end",com,nl, - "Result"]); - 'SET' -> - Imm0 = gen_dec_constructed_imm(Erule, Typename, Def), - Imm = opt_imm(Imm0), - asn1ct_name:start(), - emit(["{Result,_} = begin",nl]), - emit_gen_dec_imm(Imm), - emit([nl, - "end",com,nl, - "Result"]); - 'SET OF' -> - asn1ct_name:start(), - do_gen_decode_sof(Erule, Typename, 'SET OF', - Def, false); - 'SEQUENCE' -> - Imm0 = gen_dec_constructed_imm(Erule, Typename, Def), - Imm = opt_imm(Imm0), - asn1ct_name:start(), - emit(["{Result,_} = begin",nl]), - emit_gen_dec_imm(Imm), - emit([nl, - "end",com,nl, - "Result"]); - 'SEQUENCE OF' -> - asn1ct_name:start(), - do_gen_decode_sof(Erule, Typename, 'SEQUENCE OF', - Def, false) - end; + #typedef{name={constructed,bif},typespec=Type}=Def -> + Prefix = "dec_outlined_", + Key = {dec_outlined,Def}, + Gen = fun(_Fd, Name) -> + gen_dec_obj(Erule, Name, Typename, Type) + end, + Func = asn1ct_func:call_gen(Prefix, Key, Gen), + emit(["{Term,_} = ",{asis,Func},"(Bytes)",com,nl, + "Term"]); #typedef{name=Type} -> emit(["{Result,_} = ",{asis,enc_func("dec_", Type)},"(Bytes),",nl, "Result"]); @@ -531,6 +499,12 @@ dec_objset_2(Erule, Obj, RestFields0, Typename) -> end end. +gen_dec_obj(Erules, Name, Typename, Type) -> + emit([{asis,Name},"(Bytes) ->",nl]), + InnerType = asn1ct_gen:get_inner(Type#type.def), + asn1ct_gen:gen_decode_constructed(Erules, Typename, + InnerType, Type). + gen_encode_choice(Erule, TopType, D) -> asn1ct_name:start(), Imm = gen_encode_choice_imm(Erule, TopType, D), @@ -1024,11 +998,12 @@ enc_var_type_call(Erule, Name, RestFieldNames, #classdef{typespec=ClassDef} = asn1_db:dbget(ClMod, ClType), #objectclass{fields=ClassFields} = ClassDef, Extensible = lists:member('EXTENSIONMARK', ObjSet1), - ObjSet2 = [{Key,fix_object_code(Name, Code, ClassFields)} || - {_,Key,Code} <- ObjSet1], - ObjSet = lists:sort([P || {_,B}=P <- ObjSet2, B =/= none]), + ObjSet = index_object_set(Erule, ClType, Name, + ObjSet1, ClassFields), Key = erlang:md5(term_to_binary({encode,ObjSet,RestFieldNames,Extensible})), - Imm = enc_objset_imm(Erule, Name, ObjSet, RestFieldNames, Extensible), + TypeName = [ClType,Name], + Imm = enc_objset_imm(Erule, TypeName, Name, ObjSet, + RestFieldNames, Extensible), Lambda = {lambda,[{var,"Val"},{var,"Id"}],Imm}, Gen = fun(_Fd, N) -> Aligned = is_aligned(Erule), @@ -1039,11 +1014,27 @@ enc_var_type_call(Erule, Name, RestFieldNames, Prefix = lists:concat(["enc_os_",Name]), [{call_gen,Prefix,Key,Gen,Lambda,[Val,Fun]}]. -fix_object_code(Name, [{Name,B}|_], _ClassFields) -> - B; -fix_object_code(Name, [_|T], ClassFields) -> - fix_object_code(Name, T, ClassFields); -fix_object_code(Name, [], ClassFields) -> +index_object_set(_Erules, _ClType, Name, Set0, ClassFields) -> + Set = index_object_set_1(Name, Set0, ClassFields), + lists:sort(Set). + +index_object_set_1(Name, [{_,Key,Code}|T], ClassFields) -> + case index_object_set_2(Name, Code, ClassFields) of + none -> + index_object_set_1(Name, T, ClassFields); + Type -> + [{Key,Type}|index_object_set_1(Name, T, ClassFields)] + end; +index_object_set_1(Name, [_|T], ClassFields) -> + index_object_set_1(Name, T, ClassFields); +index_object_set_1(_, [], _) -> + []. + +index_object_set_2(Name, [{Name,Type}|_], _ClassFields) -> + Type; +index_object_set_2(Name, [_|T], ClassFields) -> + index_object_set_2(Name, T, ClassFields); +index_object_set_2(Name, [], ClassFields) -> case lists:keyfind(Name, 2, ClassFields) of {typefield,Name,'OPTIONAL'} -> none; @@ -1059,7 +1050,8 @@ fix_object_code(Name, [], ClassFields) -> end end. -enc_objset_imm(Erule, Component, ObjSet, RestFieldNames, Extensible) -> +enc_objset_imm(Erule, TypeName, Component, ObjSet, + RestFieldNames, Extensible) -> Aligned = is_aligned(Erule), E = {error, fun() -> @@ -1070,7 +1062,7 @@ enc_objset_imm(Erule, Component, ObjSet, RestFieldNames, Extensible) -> end}, [{'cond', [[{eq,{var,"Id"},Key}| - enc_obj(Erule, Obj, RestFieldNames, Aligned)] || + enc_obj(Erule, Obj, TypeName, RestFieldNames, Aligned)] || {Key,Obj} <- ObjSet] ++ [['_',case Extensible of false -> @@ -1086,24 +1078,18 @@ enc_objset_imm(Erule, Component, ObjSet, RestFieldNames, Extensible) -> end end]]}]. -enc_obj(Erule, Obj, RestFieldNames0, Aligned) -> +enc_obj(Erule, Obj, TypeName, RestFieldNames0, Aligned) -> + Val = {var,"Val"}, case Obj of + #typedef{name={constructed,bif},typespec=Type}=Def -> + Prefix = "enc_outlined_", + Key = {enc_outlined,Def}, + Gen = fun(_Fd, Name) -> + gen_enc_obj(Erule, Name, TypeName, Type) + end, + [{call_gen,Prefix,Key,Gen,undefined,[Val]}]; #typedef{name={primitive,bif},typespec=Def} -> asn1ct_gen_per:gen_encode_prim_imm({var,"Val"}, Def, Aligned); - #typedef{name={constructed,bif},typespec=Def} -> - InnerType = asn1ct_gen:get_inner(Def#type.def), - case InnerType of - 'CHOICE' -> - gen_encode_choice_imm(Erule, name, Def); - 'SET' -> - gen_encode_constructed_imm(Erule, name, Def); - 'SET OF' -> - gen_encode_sof_imm(Erule, name, InnerType, Def); - 'SEQUENCE' -> - gen_encode_constructed_imm(Erule, name, Def); - 'SEQUENCE OF' -> - gen_encode_sof_imm(Erule, name, InnerType, Def) - end; #typedef{name=Type} -> [{apply,{local,enc_func(Type),Type},[{var,"Val"}]}]; #'Externalvaluereference'{module=Mod,value=Value} -> @@ -1112,7 +1098,8 @@ enc_obj(Erule, Obj, RestFieldNames0, Aligned) -> {object,_,Fields} = Def, [NextField|RestFieldNames] = RestFieldNames0, {NextField,Typedef} = lists:keyfind(NextField, 1, Fields), - enc_obj(Erule, Typedef, RestFieldNames, Aligned) + enc_obj(Erule, Typedef, TypeName, + RestFieldNames, Aligned) end; #'Externaltypereference'{module=Mod,type=Type} -> Func = enc_func(Type), @@ -1124,6 +1111,11 @@ enc_obj(Erule, Obj, RestFieldNames0, Aligned) -> end end. +gen_enc_obj(Erules, Name, Typename, Type) -> + emit([{asis,Name},"(Val) ->",nl]), + InnerType = asn1ct_gen:get_inner(Type#type.def), + asn1ct_gen:gen_encode_constructed(Erules, Typename, + InnerType, Type). gen_dec_components_call(Erule, TopType, {Root,ExtList}, DecInfObj, Ext, NumberOfOptionals) -> -- cgit v1.2.3 From 86a2bbe5c88c1be6450b53a2b5cb30a099683762 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 1 Oct 2014 14:51:37 +0200 Subject: Fix object set duplication test Wrong fields in the record where checked when sorting, which caused duplicate objects to exist in constructed object sets and later caused an error. --- lib/asn1/src/asn1ct.erl | 8 ++- lib/asn1/src/asn1ct_check.erl | 137 ++++++++++++++++++++++++++++++++---------- 2 files changed, 110 insertions(+), 35 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index df341e5aab..cd7900f919 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -34,7 +34,8 @@ %% Application internal exports -export([compile_asn/3,compile_asn1/3,compile_py/3,compile/3, vsn/0, - get_name_of_def/1,get_pos_of_def/1]). + get_name_of_def/1,get_pos_of_def/1, + unset_pos_mod/1]). -export([read_config_data/1,get_gen_state_field/1, partial_inc_dec_toptype/1,update_gen_state/2, get_tobe_refed_func/1,reset_gen_state/0,is_function_generated/1, @@ -559,7 +560,10 @@ unset_pos_mod(Def) when is_record(Def,pvaluesetdef) -> unset_pos_mod(Def) when is_record(Def,pobjectdef) -> Def#pobjectdef{pos=undefined}; unset_pos_mod(Def) when is_record(Def,pobjectsetdef) -> - Def#pobjectsetdef{pos=undefined}. + Def#pobjectsetdef{pos=undefined}; +unset_pos_mod(#'ComponentType'{} = Def) -> + Def#'ComponentType'{pos=undefined}; +unset_pos_mod(Def) -> Def. get_pos_of_def(#typedef{pos=Pos}) -> Pos; diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index cc03cd68fe..e883ee28bd 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -914,7 +914,7 @@ check_object(S, Unknown -> exit({error,{unknown_object_set,Unknown},S}) end, - NewSet2 = remove_duplicate_objects(NewObjSet#'ObjectSet'.set), + NewSet2 = remove_duplicate_objects(S, NewObjSet#'ObjectSet'.set), NewObjSet2 = NewObjSet#'ObjectSet'{set=NewSet2}, Gen = gen_incl_set(S,NewObjSet2#'ObjectSet'.set, ClassDef), @@ -924,14 +924,101 @@ check_object(S, %% remove_duplicate_objects/1 remove duplicates of objects. %% For instance may Set contain objects of same class from %% different object sets that in fact might be duplicates. -remove_duplicate_objects(Set) when is_list(Set) -> - Pred = fun({A,B,_},{A,C,_}) when B =< C -> true; - ({A,_,_},{B,_,_}) when A < B -> true; - ('EXTENSIONMARK','EXTENSIONMARK') -> true; - (T,A) when is_tuple(T),is_atom(A) -> true;% EXTENSIONMARK last in list - (_,_) -> false - end, - lists:usort(Pred,Set). +remove_duplicate_objects(S, Set0) when is_list(Set0) -> + Set1 = lists:map(fun({_,Id,_}=Orig) -> + {{a,Id},Orig}; + ('EXTENSIONMARK'=Ext) -> + {{z,Ext},Ext} + end, Set0), + Set2 = sofs:relation(Set1), + Set3 = sofs:relation_to_family(Set2), + Set = sofs:to_external(Set3), + remove_duplicate_objects_1(S, Set). + +remove_duplicate_objects_1(S, [{{a,no_unique_value},Objs}|T]) -> + Objs ++ remove_duplicate_objects_1(S, T); +remove_duplicate_objects_1(S, [{_,[_]=Objs}|T]) -> + Objs ++ remove_duplicate_objects_1(S, T); +remove_duplicate_objects_1(S, [{{_,Id},[_|_]=Objs}|T]) -> + MakeSortable = fun(What) -> sortable_type(S, What) end, + Tagged = order_tag_set(Objs, MakeSortable), + case lists:ukeysort(1, Tagged) of + [{_,Obj}] -> + [Obj|remove_duplicate_objects_1(S, T)]; + [_|_] -> + asn1_error(S, S#state.type, {non_unique_object,Id}) + end; +remove_duplicate_objects_1(_, []) -> + []. + +order_tag_set([{_, _, Fields}=Orig|Fs], Fun) -> + Pair = {[{FId, traverse(F, Fun)} || {FId, F} <- Fields], Orig}, + [Pair|order_tag_set(Fs, Fun)]; +order_tag_set([], _) -> []. + +sortable_type(S, #'Externaltypereference'{}=ERef) -> + try get_referenced_type(S, ERef) of + {_,#typedef{}=OI} -> + OI#typedef{pos=undefined,name=undefined} + catch + _:_ -> + ERef + end; +sortable_type(_, #typedef{}=TD) -> + asn1ct:unset_pos_mod(TD#typedef{name=undefined}); +sortable_type(_, Type) -> + asn1ct:unset_pos_mod(Type). + +traverse(Structure0, Fun) -> + Structure = Fun(Structure0), + traverse_1(Structure, Fun). + +traverse_1(#typedef{typespec=TS0} = TD, Fun) -> + TS = traverse(TS0, Fun), + TD#typedef{typespec=TS}; +traverse_1(#valuedef{type=TS0} = VD, Fun) -> + TS = traverse(TS0, Fun), + VD#valuedef{type=TS}; +traverse_1(#type{def=TS0} = TD, Fun) -> + TS = traverse(TS0, Fun), + TD#type{def=TS}; +traverse_1(#'SEQUENCE'{components=Cs0} = Seq, Fun) -> + Cs = traverse_seq_set(Cs0, Fun), + Seq#'SEQUENCE'{components=Cs}; +traverse_1({'SEQUENCE OF',Type0}, Fun) -> + Type = traverse(Type0, Fun), + {'SEQUENCE OF',Type}; +traverse_1({'SET OF',Type0}, Fun) -> + Type = traverse(Type0, Fun), + {'SET OF',Type}; +traverse_1(#'SET'{components=Cs0} = Set, Fun) -> + Cs = traverse_seq_set(Cs0, Fun), + Set#'SET'{components=Cs}; +traverse_1({'CHOICE', Cs0}, Fun) -> + Cs = traverse_seq_set(Cs0, Fun), + {'CHOICE', Cs}; +traverse_1(Leaf, _) -> + Leaf. + +traverse_seq_set(List, Fun) when is_list(List) -> + traverse_seq_set_1(List, Fun); +traverse_seq_set({Set, Ext}, Fun) -> + {traverse_seq_set_1(Set, Fun), traverse_seq_set_1(Ext, Fun)}; +traverse_seq_set({Set1, Set2, Set3}, Fun) -> + {traverse_seq_set_1(Set1, Fun), + traverse_seq_set_1(Set2, Fun), + traverse_seq_set_1(Set3, Fun)}. + +traverse_seq_set_1([#'ComponentType'{} = CT0|Cs], Fun) -> + CT = #'ComponentType'{typespec=TS0} = Fun(CT0), + TS = traverse(TS0, Fun), + [CT#'ComponentType'{typespec=TS}|traverse_seq_set_1(Cs, Fun)]; +traverse_seq_set_1([{'COMPONENTS OF', _} = CO0|Cs], Fun) -> + {'COMPONENTS OF', TS0} = Fun(CO0), + TS = traverse(TS0, Fun), + [{'COMPONENTS OF', TS}|traverse_seq_set_1(Cs, Fun)]; +traverse_seq_set_1([], _) -> + []. %% extensionmark(L,true) -> @@ -1002,11 +1089,12 @@ object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,[O|Os],InterSect,Acc) - Obj -> object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,Os,InterSect,[Obj|Acc]) end; -object_set_from_objects(_S,_RefedObjMod,_ClassDef,_FieldName,[],InterSect,Acc) -> +object_set_from_objects(S,_RefedObjMod,_ClassDef,_FieldName,[],InterSect,Acc) -> %% For instance may Acc contain objects of same class from %% different object sets that in fact might be duplicates. - remove_duplicate_objects(osfo_intersection(InterSect,Acc)). -%% Acc. + Set = osfo_intersection(InterSect,Acc), + remove_duplicate_objects(S, Set). + object_set_from_objects2(S,RefedObjMod,ClassDef,[{valuefieldreference,OName}], Fields,_InterSect) -> %% this is an object @@ -1364,15 +1452,8 @@ get_unique_valuelist(S,ObjSet,{UFN,Opt}) -> get_unique_vlist(_S,[],_,_,[]) -> ['EXTENSIONMARK']; -get_unique_vlist(S,[],_,Opt,Acc) -> - case catch check_uniqueness(remove_duplicate_objects(Acc)) of - {asn1_error,_} when Opt =/= 'OPTIONAL' -> - error({'ObjectSet',"not unique objects in object set",S}); - {asn1_error,_} -> - lists:reverse(Acc); - _ -> - lists:reverse(Acc) - end; +get_unique_vlist(_, [], _, _Opt, Acc) -> + lists:reverse(Acc); get_unique_vlist(S,['EXTENSIONMARK'|Rest],UniqueFieldName,Opt,Acc) -> get_unique_vlist(S,Rest,UniqueFieldName,Opt,Acc); get_unique_vlist(S,[{ObjName,Obj}|Rest],UniqueFieldName,Opt,Acc) -> @@ -1432,18 +1513,6 @@ get_unique_value(S,Fields,UniqueFieldName) -> end end. -check_uniqueness(NameValueList) -> - check_uniqueness1(lists:keysort(2,NameValueList)). - -check_uniqueness1([]) -> - true; -check_uniqueness1([_]) -> - true; -check_uniqueness1([{_,N,_},{_,N,_}|_Rest]) -> - throw({asn1_error,{'objects in set must have unique values in UNIQUE fields',N}}); -check_uniqueness1([_|Rest]) -> - check_uniqueness1(Rest). - %% instantiate_po/4 %% ClassDef is the class of Object, %% Object is the Parameterized object, which is referenced, @@ -6561,6 +6630,8 @@ format_error({undefined_import,Ref,Module}) -> io_lib:format("'~s' is not exported from ~s", [Ref,Module]); format_error({value_reused,Val}) -> io_lib:format("the value '~p' is used more than once", [Val]); +format_error({non_unique_object,Id}) -> + io_lib:format("object set with a UNIQUE field value of '~p' is used more than once", [Id]); format_error(Other) -> io_lib:format("~p", [Other]). -- cgit v1.2.3 From e43a382e7207a3c01baba2ef202b49766b60fdae Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Tue, 7 Oct 2014 17:08:09 +0200 Subject: Clean up and correct validation of OBJECT IDENTIFIER/RELATIVE-OID Besides simplifying the code and doing better error checking and error reporting, fix the following bugs: Support retrieving an OBJECT IDENTIFIER/RELATIVE-OID from an object. Example: oid OBJECT IDENTIFIER ::= some-object.&some-field Allow an integer constant first in an OBJECT IDENTIFIER: integer INTEGER ::= 0 oid OBJECT IDENTIFIER ::= {integer 1} --- lib/asn1/src/asn1ct_check.erl | 242 ++++++++++++++++++------------------------ 1 file changed, 101 insertions(+), 141 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index e883ee28bd..996c040373 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2128,135 +2128,97 @@ is_contextswitchtype(#typedef{name='CHARACTER STRING'}) -> is_contextswitchtype(_) -> false. -%%------------ -%% This can be removed when the old parser is removed -%% The function removes 'space' atoms from the list - -is_space_list([H],Acc) -> - lists:reverse([H|Acc]); -is_space_list([H,space|T],Acc) -> - is_space_list(T,[H|Acc]); -is_space_list([],Acc) -> - lists:reverse(Acc); -is_space_list([H|T],Acc) -> - is_space_list(T,[H|Acc]). - -validate_objectidentifier(S,OID,ERef,C) - when is_record(ERef,'Externalvaluereference') -> - validate_objectidentifier(S,OID,[ERef],C); -validate_objectidentifier(S,OID,Tup,C) when is_tuple(Tup) -> - validate_objectidentifier(S,OID,tuple_to_list(Tup),C); -validate_objectidentifier(S,OID,L,_) -> - NewL = is_space_list(L,[]), - case validate_objectidentifier1(S,OID,NewL) of - NewL2 when is_list(NewL2) ->{ok,list_to_tuple(NewL2)}; - Other -> {ok,Other} - end. +%%% +%%% Start of OBJECT IDENTFIER/RELATIVE-OID validation. +%%% -validate_objectidentifier1(S, OID, [Id|T]) - when is_record(Id,'Externalvaluereference') -> - case catch get_referenced_type(S,Id) of - {M,V} when is_record(V,valuedef) -> - NewS = update_state(S,M), - case check_value(NewS,V) of - #valuedef{type=#type{def=ERef},checked=true, - value=Value} when is_tuple(Value) -> - case is_object_id(OID,NewS,ERef) of - true -> - %% T must be a RELATIVE-OID - validate_oid(true,NewS, rel_oid, T, lists:reverse(tuple_to_list(Value))); - _ -> - error({value, {"illegal "++to_string(OID),[Id|T]}, S}) - end; - _ -> - error({value, {"illegal "++to_string(OID),[Id|T]}, S}) - end; +validate_objectidentifier(S, OidType, #'Externalvaluereference'{}=Id) -> + %% Must be an OBJECT IDENTIFIER or RELATIVE-OID depending on OidType. + get_oid_value(S, OidType, false, Id); +validate_objectidentifier(S, OidType, {'ValueFromObject',{object,Obj},Fields}) -> + %% Must be an OBJECT IDENTIFIER/RELATIVE-OID depending on OidType. + case extract_field(S, Obj, Fields) of + #valuedef{checked=true,value=Value,type=Type} when is_tuple(Value) -> + _ = get_oid_type(S, OidType, Type), + Value; _ -> - validate_oid(true,S, OID, [Id|T], []) + asn1_error(S, {illegal_oid,OidType}) end; -validate_objectidentifier1(S,OID,V) -> - validate_oid(true,S,OID,V,[]). - -validate_oid(false, S, OID, V, Acc) -> - error({value, {"illegal "++to_string(OID), V,Acc}, S}); -validate_oid(_,_, _, [], Acc) -> - lists:reverse(Acc); -validate_oid(_, S, OID, [Value|Vrest], Acc) when is_integer(Value) -> - validate_oid(valid_objectid(OID,Value,Acc),S, OID, Vrest, [Value|Acc]); -validate_oid(_, S, OID, [{'NamedNumber',_Name,Value}|Vrest], Acc) - when is_integer(Value) -> - validate_oid(valid_objectid(OID,Value,Acc), S, OID, Vrest, [Value|Acc]); -validate_oid(_, S, OID, [Id|Vrest], Acc) - when is_record(Id,'Externalvaluereference') -> - case catch get_referenced_type(S, Id) of - {M,V} when is_record(V,valuedef) -> - NewS = update_state(S,M), - NewVal = case check_value(NewS, V) of - #valuedef{checked=true,value=Value} -> - fun(Int) when is_integer(Int) -> [Int]; - (L) when is_list(L) -> L; - (T) when is_tuple(T) -> tuple_to_list(T) - end (Value); - _ -> - error({value, {"illegal "++to_string(OID), - [Id|Vrest],Acc}, S}) - end, - case NewVal of - List when is_list(List) -> - validate_oid(valid_objectid(OID,NewVal,Acc), NewS, - OID, Vrest,lists:reverse(NewVal)++Acc); +validate_objectidentifier(S, OidType, + [{#seqtag{module=Mod,pos=Pos,val=Atom},Val}]) -> + %% This case is when an OBJECT IDENTIFIER value has been parsed as a + %% SEQUENCE value. + Rec = #'Externalvaluereference'{pos=Pos, + module=Mod, + value=Atom}, + validate_oid(S, OidType, [Rec,Val], []); +validate_objectidentifier(S, OidType, [_|_]=L0) -> + validate_oid(S, OidType, L0, []); +validate_objectidentifier(S, OidType, _) -> + asn1_error(S, {illegal_oid,OidType}). + +get_oid_value(S, OidType, AllowInteger, #'Externalvaluereference'{}=Id) -> + case get_referenced_type(S, Id) of + {_,#valuedef{checked=Checked,type=Type,value=V}} -> + case get_oid_type(S, OidType, Type) of + 'INTEGER' when not AllowInteger -> + asn1_error(S, {illegal_oid,OidType}); + _ when Checked -> + V; + 'INTEGER' -> + V; _ -> - NewVal + validate_objectidentifier(S, OidType, V) end; _ -> + asn1_error(S, {illegal_oid,OidType}) + end. + +validate_oid(S, OidType, [], Acc) -> + Oid = lists:reverse(Acc), + validate_oid_path(S, OidType, Oid), + list_to_tuple(Oid); +validate_oid(S, OidType, [Value|Vrest], Acc) when is_integer(Value) -> + validate_oid(S, OidType, Vrest, [Value|Acc]); +validate_oid(S, OidType, [{'NamedNumber',_Name,Value}|Vrest], Acc) + when is_integer(Value) -> + validate_oid(S, OidType, Vrest, [Value|Acc]); +validate_oid(S, OidType, [#'Externalvaluereference'{}=Id|Vrest], Acc) -> + NeededOidType = case Acc of + [] -> o_id; + [_|_] -> rel_oid + end, + try get_oid_value(S, NeededOidType, true, Id) of + Val when is_integer(Val) -> + validate_oid(S, OidType, Vrest, [Val|Acc]); + Val when is_tuple(Val) -> + L = tuple_to_list(Val), + validate_oid(S, OidType, Vrest, lists:reverse(L, Acc)) + catch + _:_ -> case reserved_objectid(Id#'Externalvaluereference'.value, Acc) of Value when is_integer(Value) -> - validate_oid(valid_objectid(OID,Value,Acc), - S, OID,Vrest, [Value|Acc]); + validate_oid(S, OidType,Vrest, [Value|Acc]); false -> - error({value, {"illegal "++to_string(OID),[Id,Vrest],Acc}, S}) + asn1_error(S, {illegal_oid,OidType}) end end; -validate_oid(_, S, OID, [{#seqtag{module=Mod,val=Atom},Value}], []) - when is_atom(Atom),is_integer(Value) -> - %% this case when an OBJECT IDENTIFIER value has been parsed as a - %% SEQUENCE value - Rec = #'Externalvaluereference'{module=Mod, - value=Atom}, - validate_objectidentifier1(S, OID, [Rec,Value]); -validate_oid(_, S, OID, [{#seqtag{module=Mod,val=Atom},EVRef}], []) - when is_atom(Atom),is_record(EVRef,'Externalvaluereference') -> - %% this case when an OBJECT IDENTIFIER value has been parsed as a - %% SEQUENCE value OTP-4354 - Rec = #'Externalvaluereference'{module=Mod, - value=Atom}, - validate_objectidentifier1(S, OID, [Rec,EVRef]); -validate_oid(_, S, OID, [#seqtag{module=Mod,val=Atom}|Rest], Acc) - when is_atom(Atom) -> - Rec = #'Externalvaluereference'{module=Mod, - value=Atom}, - validate_oid(true,S, OID, [Rec|Rest],Acc); -validate_oid(_, S, OID, V, Acc) -> - error({value, {"illegal "++to_string(OID),V,Acc},S}). - -is_object_id(OID,S,ERef=#'Externaltypereference'{}) -> - {_,OI} = get_referenced_type(S,ERef), - is_object_id(OID,S,OI#typedef.typespec); -is_object_id(o_id,_S,'OBJECT IDENTIFIER') -> - true; -is_object_id(rel_oid,_S,'RELATIVE-OID') -> - true; -is_object_id(_,_S,'INTEGER') -> - true; -is_object_id(OID,S,#type{def=Def}) -> - is_object_id(OID,S,Def); -is_object_id(_,_S,_) -> - false. - -to_string(o_id) -> - "OBJECT IDENTIFIER"; -to_string(rel_oid) -> - "RELATIVE-OID". +validate_oid(S, OidType, _V, _Acc) -> + asn1_error(S, {illegal_oid,OidType}). + +get_oid_type(S, OidType, #type{def=Def}) -> + get_oid_type(S, OidType, Def); +get_oid_type(S, OidType, #'Externaltypereference'{}=Id) -> + {_,OI} = get_referenced_type(S, Id), + get_oid_type(S, OidType, OI#typedef.typespec); +get_oid_type(_S, o_id, 'OBJECT IDENTIFIER'=T) -> + T; +get_oid_type(_S, rel_oid, 'RELATIVE-OID'=T) -> + T; +get_oid_type(_S, _, 'INTEGER'=T) -> + T; +get_oid_type(S, OidType, _) -> + asn1_error(S, {illegal_oid,OidType}). %% ITU-T Rec. X.680 Annex B - D reserved_objectid('itu-t',[]) -> 0; @@ -2295,7 +2257,6 @@ reserved_objectid('x',[0,0]) -> 24; reserved_objectid('y',[0,0]) -> 25; reserved_objectid('z',[0,0]) -> 26; - reserved_objectid(iso,[]) -> 1; %% arcs below "iso", note that number 1 is not used reserved_objectid('standard',[1]) -> 0; @@ -2307,23 +2268,20 @@ reserved_objectid('joint-iso-ccitt',[]) -> 2; reserved_objectid(_,_) -> false. -valid_objectid(_OID,[],_Acc) -> - true; -valid_objectid(OID,[H|T],Acc) -> - case valid_objectid(OID, H, Acc) of - true -> - valid_objectid(OID,T,[H|Acc]); - _ -> - false - end; -valid_objectid(o_id,I,[]) when I =:= 0; I =:= 1; I =:= 2 -> true; -valid_objectid(o_id,_I,[]) -> false; -valid_objectid(o_id,I,[0]) when I >= 0; I =< 4 -> true; -valid_objectid(o_id,_I,[0]) -> false; -valid_objectid(o_id,I,[1]) when I =:= 0; I =:= 2; I =:= 3 -> true; -valid_objectid(o_id,_I,[1]) -> false; -valid_objectid(o_id,_I,[2]) -> true; -valid_objectid(_,_,_) -> true. +validate_oid_path(_, rel_oid, _) -> + ok; +validate_oid_path(_, o_id, [0,I|_]) when 0 =< I, I =< 9 -> + ok; +validate_oid_path(_, o_id, [1,I|_]) when 0 =< I, I =< 3 -> + ok; +validate_oid_path(_, o_id, [2|_]) -> + ok; +validate_oid_path(S, o_id=OidType, _) -> + asn1_error(S, {illegal_oid,OidType}). + +%%% +%%% End of OBJECT IDENTFIER/RELATIVE-OID validation. +%%% convert_external(S=#state{type=Vtype}, Value) -> case Vtype of @@ -2545,12 +2503,10 @@ normalize_octetstring(S, Value) -> end. normalize_objectidentifier(S, Value) -> - {ok,Val} = validate_objectidentifier(S, o_id, Value, []), - Val. + validate_objectidentifier(S, o_id, Value). -normalize_relative_oid(S,Value) -> - {ok,Val} = validate_objectidentifier(S, rel_oid, Value, []), - Val. +normalize_relative_oid(S, Value) -> + validate_objectidentifier(S, rel_oid, Value). normalize_objectdescriptor(Value) -> Value. @@ -6599,6 +6555,10 @@ format_error(illegal_integer_value) -> "expecting an integer value"; format_error(illegal_object) -> "expecting an object"; +format_error({illegal_oid,o_id}) -> + "illegal OBJECT IDENTIFIER"; +format_error({illegal_oid,rel_oid}) -> + "illegal RELATIVE-OID"; format_error(illegal_octet_string_value) -> "expecting a bstring or an hstring as value for an OCTET STRING"; format_error({illegal_typereference,Name}) -> -- cgit v1.2.3 From 55f6965558bed5bfbcf178d0203b7311b447b81a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 15 Oct 2014 12:10:00 +0200 Subject: Handle CLASS.&field when checking values --- lib/asn1/src/asn1ct_check.erl | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 996c040373..9af88166e8 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2079,7 +2079,13 @@ check_valuedef(#state{recordtopname=TopName}=S0, V0) -> case Type of #classdef{} -> throw({objectdef}); - #typedef{typespec=TypeSpec} -> + #typedef{typespec=TypeSpec0}=TypeDef -> + TypeSpec = try check_type(S2, TypeDef, TypeSpec0) of + TypeSpec1 -> TypeSpec1 + catch + throw:{asn1_class,_} -> + throw({objectdef}) + end, S3 = case is_contextswitchtype(Type) of true -> S2; -- cgit v1.2.3 From 572b880ce6ad60ca0ad63aa9b4f8da01702834cf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 17 Oct 2014 12:48:40 +0200 Subject: Check more errors in the simplified syntax An optional group must not contain mandatory class fields. All mandatory fields must be included in the simplified syntax. --- lib/asn1/src/asn1ct_check.erl | 135 +++++++++++++++++++++++++++++------------- 1 file changed, 94 insertions(+), 41 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 9af88166e8..828ebdac1c 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -1664,38 +1664,80 @@ check_objectdefn(S, Def, #classdef{typespec=ObjClass}) -> end end. -get_syntax(_, {preprocessed_syntax,Syntax}, _) -> - Syntax; -get_syntax(S, {'WITH SYNTAX',Syntax}, ClassFields) -> - preprocess_syntax(S, Syntax, ClassFields). - %%% %%% Pre-process the simplified syntax so that it can be more %%% easily matched. %%% -preprocess_syntax(S, [H|T], Cs) when is_list(H) -> - [{optional,preprocess_syntax(S, H, Cs)}|preprocess_syntax(S, T, Cs)]; -preprocess_syntax(S, [{valuefieldreference,Name}|T], Cs) -> - case lists:keyfind(Name, 2, Cs) of - Tuple when is_tuple(Tuple) -> - [{field,Tuple}|preprocess_syntax(S, T, Cs)]; +get_syntax(_, {preprocessed_syntax,Syntax}, _) -> + Syntax; +get_syntax(S, {'WITH SYNTAX',Syntax}, ClassFields) -> + preprocess_syntax(S, Syntax, ClassFields). + +preprocess_syntax(S, Syntax0, Cs) -> + Syntax = preprocess_syntax_1(S, Syntax0, Cs, true), + Present0 = preprocess_get_fields(Syntax, []), + Present1 = lists:sort(Present0), + Present = ordsets:from_list(Present1), + case Present =:= Present1 of false -> - asn1_error(S, {syntax_undefined_field,Name}) - end; -preprocess_syntax(S, [{typefieldreference,Name}|T], Cs) -> + Dupl = Present1 -- Present, + asn1_error(S, {syntax_duplicated_fields,Dupl}); + true -> + ok + end, + Mandatory0 = get_mandatory_class_fields(Cs), + Mandatory = ordsets:from_list(Mandatory0), + case ordsets:subtract(Mandatory, Present) of + [] -> + Syntax; + [_|_]=Missing -> + asn1_error(S, {syntax_missing_mandatory_fields,Missing}) + end. + +preprocess_syntax_1(S, [H|T], Cs, Mandatory) when is_list(H) -> + [{optional,preprocess_syntax_1(S, H, Cs, false)}| + preprocess_syntax_1(S, T, Cs, Mandatory)]; +preprocess_syntax_1(S, [{valuefieldreference,Name}|T], Cs, Mandatory) -> + F = preprocess_check_field(S, Name, Cs, Mandatory), + [F|preprocess_syntax_1(S, T, Cs, Mandatory)]; +preprocess_syntax_1(S, [{typefieldreference,Name}|T], Cs, Mandatory) -> + F = preprocess_check_field(S, Name, Cs, Mandatory), + [F|preprocess_syntax_1(S, T, Cs, Mandatory)]; +preprocess_syntax_1(S,[{Token,_}|T], Cs, Mandatory) when is_atom(Token) -> + [{token,Token}|preprocess_syntax_1(S, T, Cs, Mandatory)]; +preprocess_syntax_1(S, [Token|T], Cs, Mandatory) when is_atom(Token) -> + [{token,Token}|preprocess_syntax_1(S, T, Cs, Mandatory)]; +preprocess_syntax_1(_, [], _, _) -> []. + +preprocess_check_field(S, Name, Cs, Mandatory) -> case lists:keyfind(Name, 2, Cs) of Tuple when is_tuple(Tuple) -> - [{field,Tuple}|preprocess_syntax(S, T, Cs)]; + case not Mandatory andalso is_mandatory_class_field(Tuple) of + true -> + asn1_error(S, {syntax_mandatory_in_optional_group,Name}); + false -> + {field,Tuple} + end; false -> asn1_error(S, {syntax_undefined_field,Name}) - end; -preprocess_syntax(S,[{Token,_}|T], Cs) when is_atom(Token) -> - [{token,Token}|preprocess_syntax(S, T, Cs)]; -preprocess_syntax(S, [Token|T], Cs) when is_atom(Token) -> - [{token,Token}|preprocess_syntax(S, T, Cs)]; -preprocess_syntax(_, [], _) -> []. + end. + +preprocess_get_fields([{field,F}|T], Acc) -> + Name = element(2, F), + preprocess_get_fields(T, [Name|Acc]); +preprocess_get_fields([{optional,L}|T], Acc) -> + preprocess_get_fields(T, preprocess_get_fields(L, Acc)); +preprocess_get_fields([_|T], Acc) -> + preprocess_get_fields(T, Acc); +preprocess_get_fields([], Acc) -> + Acc. + +%%% +%%% Match the actual fields in the object definition to +%%% the pre-processed simplified syntax. +%%% match_syntax(S, [{token,Token}|T], [A|As]=Args, Acc) -> case A of @@ -1730,7 +1772,7 @@ match_syntax(S, [{optional,L}|T], As0, Acc) -> match_syntax(_, [_|_], [], _Acc) -> {nomatch,[]}; match_syntax(_, [], As, Acc) -> - {match,lists:reverse(Acc),As}. + {match,Acc,As}. match_syntax_type(S, Type, {value_tag,Val}) -> match_syntax_type(S, Type, Val); @@ -1964,22 +2006,24 @@ check_defaultfields_1(S, [{FName,Spec}|Fields], ClassFields, Acc) -> {match,Match} = match_syntax_type(S, CField, Spec), check_defaultfields_1(S, Fields, ClassFields, Match++Acc). -get_mandatory_class_fields([{fixedtypevaluefield,Name,_,_,'MANDATORY'}|T]) -> - [Name|get_mandatory_class_fields(T)]; -get_mandatory_class_fields([{objectfield,Name,_,_,'MANDATORY'}|T]) -> - [Name|get_mandatory_class_fields(T)]; -get_mandatory_class_fields([{objectsetfield,Name,_,'MANDATORY'}|T]) -> - [Name|get_mandatory_class_fields(T)]; -get_mandatory_class_fields([{typefield,Name,'MANDATORY'}|T]) -> - [Name|get_mandatory_class_fields(T)]; -get_mandatory_class_fields([{variabletypevaluefield,Name,_,'MANDATORY'}|T]) -> - [Name|get_mandatory_class_fields(T)]; -get_mandatory_class_fields([{variabletypevaluesetfield, - Name,_,'MANDATORY'}|T]) -> - [Name|get_mandatory_class_fields(T)]; -get_mandatory_class_fields([_|T]) -> - get_mandatory_class_fields(T); -get_mandatory_class_fields([]) -> []. +get_mandatory_class_fields(ClassFields) -> + [element(2, F) || F <- ClassFields, + is_mandatory_class_field(F)]. + +is_mandatory_class_field({fixedtypevaluefield,_,_,_,'MANDATORY'}) -> + true; +is_mandatory_class_field({objectfield,_,_,_,'MANDATORY'}) -> + true; +is_mandatory_class_field({objectsetfield,_,_,'MANDATORY'}) -> + true; +is_mandatory_class_field({typefield,_,'MANDATORY'}) -> + true; +is_mandatory_class_field({variabletypevaluefield,_,_,'MANDATORY'}) -> + true; +is_mandatory_class_field({variabletypevaluesetfield,_,_,'MANDATORY'}) -> + true; +is_mandatory_class_field(_) -> + false. merged_name(#state{inputmodules=[]},ERef) -> ERef; @@ -6580,8 +6624,17 @@ format_error({missing_mandatory_fields,Fields,Obj}) -> [format_fields(Fields),Obj]); format_error({namelist_redefinition,Name}) -> io_lib:format("the name '~s' can not be redefined", [Name]); +format_error({syntax_duplicated_fields,Fields}) -> + io_lib:format("~s must only occur once in the syntax list", + [format_fields(Fields)]); format_error(syntax_nomatch) -> "unexpected end of object definition"; +format_error({syntax_mandatory_in_optional_group,Name}) -> + io_lib:format("the field '&~s' must not be within an optional group since it is not optional", + [Name]); +format_error({syntax_missing_mandatory_fields,Fields}) -> + io_lib:format("missing mandatory ~s in the syntax list", + [format_fields(Fields)]); format_error({syntax_nomatch,Actual}) -> io_lib:format("~s is not the next item allowed according to the defined syntax", [Actual]); @@ -6602,10 +6655,10 @@ format_error(Other) -> io_lib:format("~p", [Other]). format_fields([F]) -> - io_lib:format("field &~s", [F]); + io_lib:format("field '&~s'", [F]); format_fields([H|T]) -> - [io_lib:format("fields &~s", [H])| - [io_lib:format(", &~s", [F]) || F <- T]]. + [io_lib:format("fields '&~s'", [H])| + [io_lib:format(", '&~s'", [F]) || F <- T]]. error({_,{structured_error,_,_,_}=SE,_}) -> SE; -- cgit v1.2.3 From 0775ee9c7dc4957302a756b8b37cf94e372d3ecc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 28 Oct 2014 14:47:50 +0100 Subject: Improve handling of BIT STRING values --- lib/asn1/src/asn1ct_check.erl | 50 +++++++++++++++++++++---------------------- 1 file changed, 25 insertions(+), 25 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 828ebdac1c..4a67173064 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2471,36 +2471,34 @@ normalize_bitstring(S, Value, Type)-> {bstring,String} when is_list(String) -> bstring_to_bitstring(String); #'Externalvaluereference'{} -> - get_normalized_value(S, Value, Type, - fun normalize_bitstring/3, []); - RecList when is_list(RecList) -> - F = fun(#'Externalvaluereference'{value=Name}) -> - case lists:keymember(Name, 1, Type) of - true -> Name; - false -> throw({error,false}) - end; - (Name) when is_atom(Name) -> - %% Already normalized. - Name; - (Other) -> - throw({error,Other}) - end, - try - lists:map(F, RecList) - catch - throw:{error,Reason} -> - asn1ct:warning("default value not " - "compatible with type definition ~p~n", - [Reason],S, - "default value not " - "compatible with type definition"), - Value + Val = get_referenced_value(S, Value), + normalize_bitstring(S, Val, Type); + {'ValueFromObject',{object,Obj},FieldNames} -> + case extract_field(S, Obj, FieldNames) of + #valuedef{value=Val} -> + normalize_bitstring(S, Val, Type); + _ -> + asn1_error(S, illegal_bitstring_value) end; + RecList when is_list(RecList) -> + [normalize_bs_item(S, Item, Type) || Item <- RecList]; Bs when is_bitstring(Bs) -> %% Already normalized. - Bs + Bs; + _ -> + asn1_error(S, illegal_bitstring_value) end. +normalize_bs_item(S, #'Externalvaluereference'{value=Name}, Type) -> + case lists:keymember(Name, 1, Type) of + true -> Name; + false -> asn1_error(S, illegal_bitstring_value) + end; +normalize_bs_item(_, Atom, _) when is_atom(Atom) -> + Atom; +normalize_bs_item(S, _, _) -> + asn1_error(S, illegal_bitstring_value). + hstring_to_binary(L) -> byte_align(hstring_to_bitstring(L)). @@ -6595,6 +6593,8 @@ asn1_error(S, Item, Error) -> format_error({already_defined,Name,PrevLine}) -> io_lib:format("the name ~p has already been defined at line ~p", [Name,PrevLine]); +format_error(illegal_bitstring_value) -> + "expecting a BIT STRING value"; format_error({illegal_class_name,Class}) -> io_lib:format("the class name '~s' is illegal (it must start with an uppercase letter and only contain uppercase letters, digits, or hyphens)", [Class]); format_error({illegal_instance_of,Class}) -> -- cgit v1.2.3 From b9b741b23bdaab354b2b5cc8cfb424550c2dd743 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 20 Oct 2014 13:17:36 +0200 Subject: Remove special case in parser The parser handled the builtin ABSTRACT-SYNTAX and TYPE-IDENTIFIER classes specially, which caused problems. It turns out that there is no longer any need to handle those classes specially. --- lib/asn1/src/asn1ct_check.erl | 6 ------ lib/asn1/src/asn1ct_parser2.erl | 21 ++------------------- 2 files changed, 2 insertions(+), 25 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 4a67173064..81bb78f9d4 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -3194,12 +3194,6 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> TempNewDef#newt{type={'SET OF',check_setof(S,Type,Components)}, tag= merge_tags(Tag,?TAG_CONSTRUCTED(?N_SET))}; - %% This is a temporary hack until the full Information Obj Spec - %% in X.681 is supported - {#'Externaltypereference'{type='TYPE-IDENTIFIER'}, - [{typefieldreference,_,'Type'}]} -> - Ct=maybe_illicit_implicit_tag(open_type,Tag), - TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct}; {pt,Ptype,ParaList} -> %% Ptype might be a parameterized - type, object set or diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl index 3891fce8d3..bcfa779997 100644 --- a/lib/asn1/src/asn1ct_parser2.erl +++ b/lib/asn1/src/asn1ct_parser2.erl @@ -752,17 +752,8 @@ parse_DefinedType(Tokens=[{typereference,_L1,_Module},{'.',_}, parse_DefinedType([{typereference,L1,Module},{'.',_},{typereference,_,TypeName}|Rest]) -> {#type{def = #'Externaltypereference'{pos=L1,module=Module,type=TypeName}},Rest}; parse_DefinedType([{typereference,L1,TypeName}|Rest]) -> - case is_pre_defined_class(TypeName) of - false -> - {#type{def = #'Externaltypereference'{pos=L1,module=resolve_module(TypeName), - type=TypeName}},Rest}; - _ -> - throw({asn1_error, - {L1,get(asn1_module), - [got,TypeName,expected, - [typereference,'typereference.typereference', - 'typereference typereference']]}}) - end; + {#type{def = #'Externaltypereference'{pos=L1,module=resolve_module(TypeName), + type=TypeName}},Rest}; parse_DefinedType(Tokens) -> throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), [got,get_token(hd(Tokens)),expected, @@ -3234,11 +3225,3 @@ lookahead_assignment([{'END',_}|_Rest]) -> lookahead_assignment(Tokens) -> parse_Assignment(Tokens), ok. - -is_pre_defined_class('TYPE-IDENTIFIER') -> - true; -is_pre_defined_class('ABSTRACT-SYNTAX') -> - true; -is_pre_defined_class(_) -> - false. - -- cgit v1.2.3 From 09bcfc03bd2e2b2eb31f15f2410ca3b5e8e76616 Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Wed, 22 Oct 2014 10:59:13 +0200 Subject: Fix recursive get_referenced_type --- lib/asn1/src/asn1ct_check.erl | 28 +++++++++++----------------- 1 file changed, 11 insertions(+), 17 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 81bb78f9d4..779e4f1455 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -645,7 +645,7 @@ check_class_fields(S,[F|Fields],Acc) -> Cat = case asn1ct_gen:type(asn1ct_gen:get_inner(Type2#type.def)) of Def when is_record(Def,'Externaltypereference') -> - {_,D} = get_referenced_type(S,Def), + {_,D} = get_referenced_type(S, Def, true), D; {undefined,user} -> %% neither of {primitive,bif} or {constructed,bif} @@ -2923,7 +2923,7 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> inlined=IsInlined}, TestFun = fun(Tref) -> - MaybeChoice = get_non_typedef(S, Tref), + {_, MaybeChoice} = get_referenced_type(S, Tref, true), case catch((MaybeChoice#typedef.typespec)#type.def) of {'CHOICE',_} -> maybe_illicit_implicit_tag(choice,Tag); @@ -2941,7 +2941,7 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> case Def of Ext when is_record(Ext,'Externaltypereference') -> {RefMod,RefTypeDef,IsParamDef} = - case get_referenced_type(S,Ext) of + case get_referenced_type(S, Ext) of {undefined,TmpTDef} -> %% A parameter {get(top_module),TmpTDef,true}; {TmpRefMod,TmpRefDef} -> @@ -3261,14 +3261,6 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> check_type(_S,Type,Ts) -> exit({error,{asn1,internal_error,Type,Ts}}). -get_non_typedef(S, Tref0) -> - case get_referenced_type(S, Tref0) of - {_,#typedef{typespec=#type{def=#'Externaltypereference'{}=Tref}}} -> - get_non_typedef(S, Tref); - {_,Type} -> - Type - end. - %% %% Simplify the backends by getting rid of an #'ObjectClassFieldType'{} @@ -3321,10 +3313,10 @@ get_innertag(_S,#'ObjectClassFieldType'{type=Type}) -> %% get_class_def(S, Type) -> #classdef{} | 'none'. get_class_def(S, #typedef{typespec=#type{def=#'Externaltypereference'{}=Eref}}) -> - {_,NextDef} = get_referenced_type(S, Eref), + {_,NextDef} = get_referenced_type(S, Eref, true), get_class_def(S, NextDef); get_class_def(S, #'Externaltypereference'{}=Eref) -> - {_,NextDef} = get_referenced_type(S, Eref), + {_,NextDef} = get_referenced_type(S, Eref, true), get_class_def(S, NextDef); get_class_def(_S, #classdef{}=CD) -> CD; @@ -4416,11 +4408,13 @@ get_referenced_value(S, T) -> end. get_referenced_type(S, T) -> + get_referenced_type(S, T, false). + +get_referenced_type(S, T, Recurse) -> case do_get_referenced_type(S, T) of - {_,#type{def=#'Externaltypereference'{}=ERef}} -> - get_referenced_type(S, ERef); - {_,#type{def=#'Externalvaluereference'{}=VRef}} -> - get_referenced_type(S, VRef); + {_,#typedef{typespec=#type{def=#'Externaltypereference'{}=ERef}}} + when Recurse -> + get_referenced_type(S, ERef, Recurse); {_,_}=Res -> Res end. -- cgit v1.2.3 From 1c79a4fd03cea47d20f5de00bbdaa8b8bd025ad0 Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Tue, 28 Oct 2014 12:52:12 +0100 Subject: Use recursive get_referenced_type to get classdef directly To be sure that indirect references to classes are solved. --- lib/asn1/src/asn1ct_check.erl | 41 +++++++++++++++-------------------------- 1 file changed, 15 insertions(+), 26 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 779e4f1455..f30bd38bfb 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -761,30 +761,19 @@ check_object(_S,ObjDef,ObjSpec) when (ObjDef#typedef.checked == true) -> ObjSpec; check_object(S,_ObjDef,#'Object'{classname=ClassRef,def=ObjectDef}) -> ?dbg("check_object ~p~n",[ObjectDef]), -%% io:format("check_object,object: ~p~n",[ObjectDef]), -% {MName,_ClassDef} = get_referenced_type(S,ClassRef), - NewClassRef = check_externaltypereference(S,ClassRef), - ClassDef = - case get_referenced_type(S,ClassRef) of - {MName,ClDef=#classdef{checked=false}} -> - NewState = update_state(S#state{type=ClDef, - tname=ClassRef#'Externaltypereference'.type},MName), - ObjClass= - check_class(NewState,ClDef), - #classdef{checked=true, - typespec=ObjClass}; - {_,_ClDef} when is_record(_ClDef,classdef) -> - _ClDef; - {MName,_TDef=#typedef{checked=false,pos=Pos, - name=_TName,typespec=TS}} -> - ClDef = #classdef{pos=Pos,name=_TName,typespec=TS}, - NewState = update_state(S#state{type=_TDef, - tname=ClassRef#'Externaltypereference'.type},MName), - ObjClass = - check_class(NewState,ClDef), - ClDef#classdef{checked=true,typespec=ObjClass}; - {_,_ClDef} -> - _ClDef + _ = check_externaltypereference(S,ClassRef), + {ClassDef, NewClassRef} = + case get_referenced_type(S, ClassRef, true) of + {MName,#classdef{checked=false, name=CLName}=ClDef} -> + Type = ClassRef#'Externaltypereference'.type, + NewState = update_state(S#state{type=ClDef, tname=Type}, MName), + ObjClass = check_class(NewState, ClDef), + {ClDef#classdef{checked=true, typespec=ObjClass}, + #'Externaltypereference'{module=MName, type=CLName}}; + {MName,#classdef{name=CLName}=ClDef} -> + {ClDef, #'Externaltypereference'{module=MName, type=CLName}}; + _ -> + asn1_error(S, illegal_object) end, NewObj = case ObjectDef of @@ -809,8 +798,8 @@ check_object(S,_ObjDef,#'Object'{classname=ClassRef,def=ObjectDef}) -> NewSettingList = check_objectdefn(S, Def, ClassDef), #'Object'{def=NewSettingList} end, - Gen = gen_incl(S,NewObj#'Object'.def, - (ClassDef#classdef.typespec)#objectclass.fields), + Fields = (ClassDef#classdef.typespec)#objectclass.fields, + Gen = gen_incl(S,NewObj#'Object'.def, Fields), NewObj#'Object'{classname=NewClassRef,gen=Gen}; -- cgit v1.2.3 From 079858313bb508d4b3ef4a8ea7a3240156c6b294 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 29 Oct 2014 12:32:29 +0100 Subject: Clean up constraint checking --- lib/asn1/src/asn1ct_check.erl | 166 +++++++++++++++++++----------------------- 1 file changed, 73 insertions(+), 93 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index f30bd38bfb..7433529034 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2983,11 +2983,9 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> case asn1ct_gen:prim_bif(asn1ct_gen:get_inner(RefType#type.def)) of true -> %% Here we expand to a built in type and inline it - NewS2 = S#state{type=#typedef{typespec=RefType}}, - NewC = - constraint_merge(NewS2, - check_constraints(NewS2,Constr)++ - RefType#type.constraint), + Constr2 = check_constraints(S, RefType, Constr), + NewC = constraint_merge(S, Constr2 ++ + RefType#type.constraint), TempNewDef#newt{ type = RefType#type.def, tag = merge_tags(Ct,RefType#type.tag), @@ -3242,7 +3240,7 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> #newt{type=TDef,tag=NewTags,constraint=NewConstr,inlined=Inlined} = NewDef, Ts#type{def=TDef, inlined=Inlined, - constraint=check_constraints(S, NewConstr), + constraint=check_constraints(S, #type{def=TDef}, NewConstr), tag=lists:map(fun(#tag{type={default,TTx}}=TempTag) -> TempTag#tag{type=TTx}; (Other) -> Other @@ -3611,86 +3609,85 @@ parse_objectset(Set) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% check_constraints/2 %% -check_constraints(S,C) when is_list(C) -> - check_constraints(S, C, []). +check_constraints(S, T, C) when is_list(C) -> + check_constraints(S, T, C, []). -resolv_tuple_or_list(S,List) when is_list(List) -> - lists:map(fun(X)->resolv_value(S,X) end, List); -resolv_tuple_or_list(S,{Lb,Ub}) -> - {resolv_value(S,Lb),resolv_value(S,Ub)}. +resolve_tuple_or_list(S, HostType, List) when is_list(List) -> + [resolve_value(S, HostType, X) || X <- List]; +resolve_tuple_or_list(S, HostType, {Lb,Ub}) -> + {resolve_value(S, HostType, Lb),resolve_value(S, HostType, Ub)}. %%%----------------------------------------- %% If the constraint value is a defined value the valuename %% is replaced by the actual value %% -resolv_value(S,Val) -> +resolve_value(S, HostType, Val) -> Id = match_parameters(S,Val, S#state.parameters), - resolv_value1(S,Id). + resolve_value1(S, HostType, Id). -resolv_value1(S, ERef = #'Externalvaluereference'{value=Name}) -> - case catch resolve_namednumber(S, S#state.type, Name) of +resolve_value1(S, HostType, #'Externalvaluereference'{value=Name}=ERef) -> + case resolve_namednumber(S, HostType, Name) of V when is_integer(V) -> V; - _ -> - case get_referenced_type(S,ERef) of - {Err,_Reason} when Err == error; Err == 'EXIT' -> - throw({error,{asn1,{undefined_type_or_value, - Name}}}); - {_M,VDef} -> - resolv_value1(S,VDef) - end + not_named -> + resolve_value1(S, HostType, get_referenced_value(S, ERef)) end; -resolv_value1(S, {gt,V}) -> - case resolv_value1(S, V) of +resolve_value1(S, HostType, {gt,V}) -> + case resolve_value1(S, HostType, V) of Int when is_integer(Int) -> Int + 1; _Other -> asn1_error(S, illegal_integer_value) end; -resolv_value1(S, {lt,V}) -> - case resolv_value1(S, V) of +resolve_value1(S, HostType, {lt,V}) -> + case resolve_value1(S, HostType, V) of Int when is_integer(Int) -> Int - 1; _Other -> asn1_error(S, illegal_integer_value) end; -resolv_value1(S, {'ValueFromObject',{object,Object},FieldName}) -> +resolve_value1(S, _HostType, {'ValueFromObject',{object,Object},FieldName}) -> get_value_from_object(S, Object, FieldName); -resolv_value1(_,#valuedef{checked=true,value=V}) -> +resolve_value1(_, _, #valuedef{checked=true,value=V}) -> V; -resolv_value1(S, #valuedef{value={'ValueFromObject', - {object,Object},FieldName}}) -> +resolve_value1(S, _, #valuedef{value={'ValueFromObject', + {object,Object},FieldName}}) -> get_value_from_object(S, Object, FieldName); -resolv_value1(S,VDef = #valuedef{}) -> +resolve_value1(S, _HostType, #valuedef{}=VDef) -> #valuedef{value=Val} = check_value(S,VDef), Val; -resolv_value1(_,V) -> +resolve_value1(_, _, V) -> V. -resolve_namednumber(S,#typedef{typespec=Type},Name) -> - case Type#type.def of +resolve_namednumber(S, #type{def=Def}=Type, Name) -> + case Def of {'ENUMERATED',NameList} -> resolve_namednumber_1(S, Name, NameList, Type); {'INTEGER',NameList} -> resolve_namednumber_1(S, Name, NameList, Type); _ -> - not_enumerated + not_named end. resolve_namednumber_1(S, Name, NameList, Type) -> - NamedNumberList = check_enumerated(S, NameList, Type#type.constraint), - {_,N} = lookup_enum_value(S, Name, NamedNumberList), - N. + try + NamedNumberList = check_enumerated(S, NameList, Type#type.constraint), + {_,N} = lookup_enum_value(S, Name, NamedNumberList), + N + catch _:_ -> + not_named + end. -check_constraints(S,[{'ContainedSubtype',Type} | Rest], Acc) -> +check_constraints(S, HostType, [{'ContainedSubtype',Type}|T], Acc) -> {RefMod,CTDef} = get_referenced_type(S,Type#type.def), NewS = S#state{module=load_asn1_module(S,RefMod),mname=RefMod, type=CTDef,tname=get_datastr_name(CTDef)}, CType = check_type(NewS,S#state.tname,CTDef#typedef.typespec), - check_constraints(S,Rest,CType#type.constraint ++ Acc); -check_constraints(S,[C | Rest], Acc) -> - check_constraints(S,Rest,[check_constraint(S,C) | Acc]); -check_constraints(S,[],Acc) -> + check_constraints(S, HostType, T, CType#type.constraint ++ Acc); +check_constraints(S, HostType, [C0|T], Acc) -> + C = check_constraint(S, HostType, C0), + check_constraints(S, HostType, T, [C|Acc]); +check_constraints(S, _, [], Acc) -> constraint_merge(S,Acc). @@ -3704,17 +3701,15 @@ range_check(Err={_,_}) -> range_check(Value) -> Value. -check_constraint(S,Ext) when is_record(Ext,'Externaltypereference') -> - check_externaltypereference(S,Ext); - - -check_constraint(S,{'SizeConstraint',{Lb,Ub}}) +check_constraint(S, _HostType, #'Externaltypereference'{}=Ext) -> + check_externaltypereference(S, Ext); +check_constraint(S, HostType, {'SizeConstraint',{Lb,Ub}}) when is_list(Lb); tuple_size(Lb) =:= 2 -> - NewLb = range_check(resolv_tuple_or_list(S,Lb)), - NewUb = range_check(resolv_tuple_or_list(S,Ub)), + NewLb = range_check(resolve_tuple_or_list(S, HostType, Lb)), + NewUb = range_check(resolve_tuple_or_list(S, HostType, Ub)), {'SizeConstraint',{NewLb,NewUb}}; -check_constraint(S,{'SizeConstraint',{Lb,Ub}}) -> - case {resolv_value(S,Lb),resolv_value(S,Ub)} of +check_constraint(S, HostType, {'SizeConstraint',{Lb,Ub}}) -> + case {resolve_value(S, HostType, Lb),resolve_value(S, HostType, Ub)} of {FixV,FixV} -> {'SizeConstraint',FixV}; {Low,High} when Low < High -> @@ -3722,35 +3717,27 @@ check_constraint(S,{'SizeConstraint',{Lb,Ub}}) -> Err -> throw({error,{asn1,{illegal_size_constraint,Err}}}) end; -check_constraint(S,{'SizeConstraint',Lb}) -> - {'SizeConstraint',resolv_value(S,Lb)}; - -check_constraint(S,{'SingleValue', L}) when is_list(L) -> - F = fun(A) -> resolv_value(S,A) end, +check_constraint(S, HostType, {'SizeConstraint',Lb}) -> + {'SizeConstraint',resolve_value(S, HostType, Lb)}; +check_constraint(S, HostType, {'SingleValue', L}) when is_list(L) -> + F = fun(A) -> resolve_value(S, HostType, A) end, {'SingleValue',lists:sort(lists:map(F,L))}; - -check_constraint(S,{'SingleValue', V}) when is_integer(V) -> - Val = resolv_value(S,V), -%% [{'SingleValue',Val},{'ValueRange',{Val,Val}}]; % Why adding value range? - {'SingleValue',Val}; -check_constraint(S,{'SingleValue', V}) -> - {'SingleValue',resolv_value(S,V)}; - -check_constraint(S,{'ValueRange', {Lb, Ub}}) -> - {'ValueRange',{resolv_value(S,Lb),resolv_value(S,Ub)}}; +check_constraint(S, HostType, {'SingleValue', V}) -> + {'SingleValue',resolve_value(S, HostType, V)}; +check_constraint(S, HostType, {'ValueRange', {Lb, Ub}}) -> + {'ValueRange',{resolve_value(S, HostType, Lb), + resolve_value(S, HostType, Ub)}}; %% In case of a constraint with extension marks like (1..Ub,...) -check_constraint(S,{VR={'ValueRange', {_Lb, _Ub}},Rest}) -> - {check_constraint(S,VR),Rest}; -check_constraint(_S,{'PermittedAlphabet',PA}) -> +check_constraint(S, HostType, {VR={'ValueRange', {_Lb, _Ub}},Rest}) -> + {check_constraint(S, HostType, VR),Rest}; +check_constraint(_S, _HostType, {'PermittedAlphabet',PA}) -> {'PermittedAlphabet',permitted_alphabet_cnstr(PA)}; - -check_constraint(S,{valueset,Type}) -> - {valueset,check_type(S,S#state.tname,Type)}; - -check_constraint(_S,ST={simpletable,Type}) when is_atom(Type) -> +check_constraint(S, HostType, {valueset,Type}) -> + {valueset,check_type(S, #typedef{typespec=HostType}, Type)}; +check_constraint(_S, _HostType, {simpletable,Type}=ST) when is_atom(Type) -> %% An already checked constraint ST; -check_constraint(S,{simpletable,Type}) -> +check_constraint(S, HostType, {simpletable,Type}) -> Def = case Type of #type{def=D} -> D; {'SingleValue',ObjRef = #'Externalvaluereference'{}} -> @@ -3761,9 +3748,6 @@ check_constraint(S,{simpletable,Type}) -> #'Externaltypereference'{} -> ERef = check_externaltypereference(S,C), {simpletable,ERef#'Externaltypereference'.type}; - #type{def=#'Externaltypereference'{}=ExtTypeRef} -> - ERef = check_externaltypereference(S, ExtTypeRef), - {simpletable,ERef#'Externaltypereference'.type}; {valueset,#type{def=ERef=#'Externaltypereference'{}}} -> % this is an object set {_,TDef} = get_referenced_type(S,ERef), case TDef#typedef.typespec of @@ -3798,12 +3782,11 @@ check_constraint(S,{simpletable,Type}) -> %% This is an ObjectFromObject. {simpletable,extract_field(S, Object, FieldNames)}; _ -> - check_type(S,S#state.tname,Type),%% this seems stupid. + check_type(S, HostType, Type),%% this seems stupid. OSName = Def#'Externaltypereference'.type, {simpletable,OSName} end; - -check_constraint(S,{componentrelation,{objectset,Opos,Objset},Id}) -> +check_constraint(S, _HostType, {componentrelation,{objectset,Opos,Objset},Id}) -> %% Objset is an 'Externaltypereference' record, since Objset is %% a DefinedObjectSet. RealObjset = match_parameters(S,Objset,S#state.parameters), @@ -3815,16 +3798,13 @@ check_constraint(S,{componentrelation,{objectset,Opos,Objset},Id}) -> end, Ext = check_externaltypereference(S,ObjSetRef), {componentrelation,{objectset,Opos,Ext},Id}; - -check_constraint(S,Type) when is_record(Type,type) -> - #type{def=Def} = check_type(S,S#state.tname,Type), +check_constraint(S, HostType, #type{}=Type) -> + #type{def=Def} = check_type(S, HostType, Type), Def; - -check_constraint(S,C) when is_list(C) -> - lists:map(fun(X)->check_constraint(S,X) end,C); -% else keep the constraint unchanged -check_constraint(_S,Any) -> -% io:format("Constraint = ~p~n",[Any]), +check_constraint(S, HostType, C) when is_list(C) -> + [check_constraint(S, HostType, X) || X <- C]; +%% else keep the constraint unchanged +check_constraint(_S, _HostType, Any) -> Any. permitted_alphabet_cnstr(T) when is_tuple(T) -> -- cgit v1.2.3 From d0b902b1909ae6d17fd2548baf0fd95ab44f0631 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 30 Oct 2014 14:09:45 +0100 Subject: Simplify and correct tag handling There is no reason to handle tags differently depending on the back-end. The PER back-end will simply ignore tags. There is also a bug in tags the ABSTRACT-SYNTAX and TYPE-IDENTIFIER pre-defined classes. So far it has not caused problems, but it could do in a future commit, such as the next commit... --- lib/asn1/src/asn1ct_check.erl | 66 +++++++++++-------------------------------- 1 file changed, 16 insertions(+), 50 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 7433529034..5f07933c74 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -60,17 +60,9 @@ -define(N_BMPString, 30). -define(TAG_PRIMITIVE(Num), - case S#state.erule of - ber -> - #tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=0}; - _ -> [] - end). + #tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=0}). -define(TAG_CONSTRUCTED(Num), - case S#state.erule of - ber -> - #tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=32}; - _ -> [] - end). + #tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=32}). -record(newt,{type=unchanged,tag=unchanged,constraint=unchanged,inlined=no}). % used in check_type to update type and tag @@ -2996,13 +2988,7 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> NewExt = ExtRef#'Externaltypereference'{module=merged_mod(S,RefMod,Ext)}, TempNewDef#newt{ type = check_externaltypereference(S,NewExt), - tag = case S#state.erule of - ber -> - merge_tags(Ct,RefType#type.tag); - _ -> - Ct - end - } + tag = merge_tags(Ct,RefType#type.tag)} end; 'ANY' -> Ct=maybe_illicit_implicit_tag(open_type,Tag), @@ -4749,12 +4735,7 @@ iof_associated_type(S,[]) -> case get(instance_of) of undefined -> AssociateSeq = iof_associated_type1(S,[]), - Tag = - case S#state.erule of - ber -> - [?TAG_CONSTRUCTED(?N_INSTANCE_OF)]; - _ -> [] - end, + Tag = [?TAG_CONSTRUCTED(?N_INSTANCE_OF)], TypeDef=#typedef{checked=true, name='INSTANCE OF', typespec=#type{tag=Tag, @@ -4780,16 +4761,11 @@ iof_associated_type1(S,C) -> [] -> 'ASN1_OPEN_TYPE'; _ -> {typefield,'Type'} end, - {ObjIdTag,C1TypeTag}= - case S#state.erule of - ber -> - {[{'UNIVERSAL',8}], - [#tag{class='UNIVERSAL', - number=6, - type='IMPLICIT', - form=0}]}; - _ -> {[{'UNIVERSAL','INTEGER'}],[]} - end, + ObjIdTag = [{'UNIVERSAL',8}], + C1TypeTag = [#tag{class='UNIVERSAL', + number=6, + type='IMPLICIT', + form=0}], TypeIdentifierRef=#'Externaltypereference'{module=ModuleName, type='TYPE-IDENTIFIER'}, ObjectIdentifier = @@ -6333,18 +6309,8 @@ get_taglist(S,{ObjCl,FieldNameList}) when is_record(ObjCl,objectclass), {fixedtypevaluefield,_,Type} -> get_taglist(S,Type); {TypeFieldName,_} when is_atom(TypeFieldName) -> []%should check if allowed end; -get_taglist(S,Def) -> - case S#state.erule of - ber -> - []; - _ -> - case Def of - 'ASN1_OPEN_TYPE' -> % open_type has no UNIVERSAL tag as such - []; - _ -> - [asn1ct_gen:def_to_tag(Def)] - end - end. +get_taglist(_, _) -> + []. get_taglist1(S,[#'ComponentType'{name=_Cname,tags=TagL}|Rest]) when is_list(TagL) -> %% tag_list has been here , just return TagL and continue with next alternative @@ -6832,7 +6798,7 @@ default_type_list() -> include_default_class(S, Module) -> _ = [include_default_class1(S, Module, ClassDef) || - ClassDef <- default_class_list(S)], + ClassDef <- default_class_list()], ok. include_default_class1(S, Module, {Name,Ts0}) -> @@ -6849,11 +6815,11 @@ include_default_class1(S, Module, {Name,Ts0}) -> ok end. -default_class_list(S) -> +default_class_list() -> [{'TYPE-IDENTIFIER', #objectclass{fields=[{fixedtypevaluefield, id, - #type{tag=?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER), + #type{tag=[?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER)], def='OBJECT IDENTIFIER'}, 'UNIQUE', 'MANDATORY'}, @@ -6866,14 +6832,14 @@ default_class_list(S) -> {'ABSTRACT-SYNTAX', #objectclass{fields=[{fixedtypevaluefield, id, - #type{tag=?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER), + #type{tag=[?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER)], def='OBJECT IDENTIFIER'}, 'UNIQUE', 'MANDATORY'}, {typefield,'Type','MANDATORY'}, {fixedtypevaluefield, property, - #type{tag=?TAG_PRIMITIVE(?N_BIT_STRING), + #type{tag=[?TAG_PRIMITIVE(?N_BIT_STRING)], def={'BIT STRING',[]}}, undefined, {'DEFAULT', -- cgit v1.2.3 From 5abac511937a99414902d3052fb633e1a65812d3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 30 Oct 2014 14:12:51 +0100 Subject: Fix instantiation of an inlined type in a value definition --- lib/asn1/src/asn1ct_check.erl | 25 ++++++++----------------- 1 file changed, 8 insertions(+), 17 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 5f07933c74..904979e86e 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -395,7 +395,7 @@ do_checkv(S, Name, Value) {pobjectsetdef,Name}; {objectsetdef} -> {objectsetdef,Name}; - {objectdef} -> + {asn1_class, _} -> %% this is an object, save as typedef #valuedef{checked=C,pos=Pos,name=N,type=Type, value=Def} = Value, @@ -1398,7 +1398,7 @@ check_fieldname_element_1(S, #valuedef{}=VDef) -> try check_value(S, VDef) catch - throw:{objectdef} -> + throw:{asn1_class, _} -> #valuedef{checked=C,pos=Pos,name=N,type=Type, value=Def} = VDef, ClassName = Type#type.def, @@ -2091,8 +2091,9 @@ check_value(S, #valuedef{}=V) -> end. check_valuedef(#state{recordtopname=TopName}=S0, V0) -> - #valuedef{name=Name,type=Vtype,value=Value,module=ModName} = V0, + #valuedef{name=Name,type=Vtype0,value=Value,module=ModName} = V0, V = V0#valuedef{checked=true}, + Vtype = check_type(S0, #typedef{name=Name,typespec=Vtype0},Vtype0), Def = Vtype#type.def, S1 = S0#state{type=Vtype,tname=Def,value=V0,vname=Name}, SVal = update_state(S1, ModName), @@ -2102,15 +2103,8 @@ check_valuedef(#state{recordtopname=TopName}=S0, V0) -> %% If V isn't a value but an object Type is a #classdef{} S2 = update_state(S1, RefM), case Type of - #classdef{} -> - throw({objectdef}); #typedef{typespec=TypeSpec0}=TypeDef -> - TypeSpec = try check_type(S2, TypeDef, TypeSpec0) of - TypeSpec1 -> TypeSpec1 - catch - throw:{asn1_class,_} -> - throw({objectdef}) - end, + TypeSpec = check_type(S2, TypeDef, TypeSpec0), S3 = case is_contextswitchtype(Type) of true -> S2; @@ -2127,7 +2121,7 @@ check_valuedef(#state{recordtopname=TopName}=S0, V0) -> V#valuedef{type=Type}), V#valuedef{value=CheckedVal} end; - 'ANY' -> + 'ASN1_OPEN_TYPE' -> {opentypefieldvalue,ANYType,ANYValue} = Value, CheckedV = check_value(SVal,#valuedef{name=Name, type=ANYType, @@ -2141,11 +2135,6 @@ check_valuedef(#state{recordtopname=TopName}=S0, V0) -> #'SEQUENCE'{} -> {ok,SeqVal} = convert_external(SVal, Value), V#valuedef{value=normalize_value(SVal, Vtype, SeqVal, TopName)}; - {'SelectionType',SelName,SelT} -> - CheckedT = check_selectiontype(SVal, SelName, SelT), - NewV = V#valuedef{type=CheckedT}, - SelVDef = check_value(S1#state{value=NewV}, NewV), - V#valuedef{value=SelVDef#valuedef.value}; _ -> V#valuedef{value=normalize_value(SVal, Vtype, Value, TopName)} end. @@ -3220,6 +3209,8 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> CheckedT = check_selectiontype(S,Name,T), TempNewDef#newt{tag=merge_tags(Tag,CheckedT#type.tag), type=CheckedT#type.def}; + 'ASN1_OPEN_TYPE' -> + TempNewDef; Other -> exit({'cant check' ,Other}) end, -- cgit v1.2.3 From 652767e7b8296296ef08294e001353fe304b964a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 3 Nov 2014 12:12:30 +0100 Subject: Clean up handling of 'simpletable' and 'componentrelation' The constraint_member/2 function is used for looking up 'simpletable' and 'componentrelation' constraints. Both parts of its name are misleading. The "constraint" part makes you think that it is a general function for constraints, but it is not - it can only search for 'simpletable' and 'componentrelation'. The "member" part makes you think that it would return a boolean, but it returns either {true,Tuple} or false, making it more similar to lists:keysearch/3. Use lists:keyfind/3 (or lists:keymember/3) instead of constraint_member/2. Also use lists:keyfind/3 in one place where there was a direct matching of a 'simpletable' constraint. --- lib/asn1/src/asn1ct_check.erl | 54 +++++++++++++++++++------------------------ 1 file changed, 24 insertions(+), 30 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 904979e86e..5533525fa9 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -4795,9 +4795,15 @@ iof_associated_type1(S,C) -> %% returns the leading attribute, the constraint of the components and %% the tablecinf value for the second component. -instance_of_constraints(_,[]) -> - {false,[],[],[]}; -instance_of_constraints(S, [{simpletable,Type}]) -> +instance_of_constraints(S, Constr) -> + case lists:keyfind(simpletable, 1, Constr) of + false -> + {false,[],[],[]}; + {simpletable,Type} -> + instance_of_constraints_1(S, Type) + end. + +instance_of_constraints_1(S, Type) -> #type{def=#'Externaltypereference'{type=Name}} = Type, ModuleName = S#state.mname, ObjectSetRef=#'Externaltypereference'{module=ModuleName, @@ -5702,10 +5708,10 @@ get_simple_table_info1(S,#'ComponentType'{typespec=TS},[],Path) -> %% In this component there must be a simple table constraint %% o.w. the asn1 code is wrong. #type{def=OCFT,constraint=Cnstr} = TS, - case constraint_member(simpletable,Cnstr) of - {true,{simpletable,_OSRef}} -> + case lists:keymember(simpletable, 1, Cnstr) of + true -> simple_table_info(S,OCFT,Path); - _ -> + false -> error({type,{"missing expected simple table constraint", Cnstr},S}) end; @@ -5761,9 +5767,8 @@ simple_table_info(S,Type,_) -> %% is found to check the validity of the at-list. any_component_relation(S,[#'ComponentType'{name=CName,typespec=Type}|Cs],CNames,NamePath,Acc) -> CRelPath = - case constraint_member(componentrelation,Type#type.constraint) of -%% [{componentrelation,_,AtNotation}] -> - {true,{_,_,AtNotation}} -> + case lists:keyfind(componentrelation, 1, Type#type.constraint) of + {_,_,AtNotation} -> %% Found component relation constraint, now check %% whether this constraint is relevant for the level %% where the search started @@ -5772,7 +5777,7 @@ any_component_relation(S,[#'ComponentType'{name=CName,typespec=Type}|Cs],CNames, %% simple table constraint from where the component %% relation is found. evaluate_atpath(S,NamePath,CNames,AtNot); - _ -> + false -> [] end, InnerAcc = @@ -5794,11 +5799,11 @@ any_component_relation(S,[#'ComponentType'{name=CName,typespec=Type}|Cs],CNames, any_component_relation(S,Cs,CNames,NamePath,InnerAcc++CRelPath++Acc); any_component_relation(S,Type,CNames,NamePath,Acc) when is_record(Type,type) -> CRelPath = - case constraint_member(componentrelation,Type#type.constraint) of - {true,{_,_,AtNotation}} -> + case lists:keyfind(componentrelation, 1, Type#type.constraint) of + {_,_,AtNotation} -> AtNot = extract_at_notation(AtNotation), evaluate_atpath(S,NamePath,CNames,AtNot); - _ -> + false -> [] end, InnerAcc = @@ -5820,15 +5825,6 @@ any_component_relation(S,['ExtensionAdditionGroupEnd'|Cs],CNames,NamePath,Acc) - any_component_relation(_,[],_,_,Acc) -> Acc. -constraint_member(componentrelation,[CRel={componentrelation,_,_}|_Rest]) -> - {true,CRel}; -constraint_member(simpletable,[ST={simpletable,_}|_Rest]) -> - {true,ST}; -constraint_member(Key,[_H|T]) -> - constraint_member(Key,T); -constraint_member(_,[]) -> - false. - %% evaluate_atpath/4 finds out whether the at notation refers to the %% search level. The list of referenced names in the AtNot list shall %% begin with a name that exists on the level it refers to. If the @@ -5936,8 +5932,8 @@ componentrelation1(S,C = #type{def=Def,constraint=Constraint,tablecinf=TCI}, Ret = % case Constraint of % [{componentrelation,{_,_,ObjectSet},AtList}|_Rest] -> - case constraint_member(componentrelation,Constraint) of - {true,{_,{_,_,ObjectSet},AtList}} -> + case lists:keyfind(componentrelation, 1, Constraint) of + {_,{_,_,ObjectSet},AtList} -> [{_,AL=[#'Externalvaluereference'{}|_R1]}|_R2] = AtList, %% Note: if Path is longer than one,i.e. it is within %% an inner type of the actual level, then the only @@ -5948,7 +5944,7 @@ componentrelation1(S,C = #type{def=Def,constraint=Constraint,tablecinf=TCI}, lists:map(fun(#'Externalvaluereference'{value=V})->V end, AL), {[{ObjectSet,AtPath,ClassDef,Path}],Def}; - _ -> + false -> %% check the inner type of component innertype_comprel(S,Def,Path) end, @@ -6022,10 +6018,8 @@ componentlist_comprel(_,[],Acc,_,NewCL) -> innertype_comprel1(S,T = #type{def=Def,constraint=Cons,tablecinf=TCI},Path) -> Ret = -% case Cons of -% [{componentrelation,{_,_,ObjectSet},AtList}|_Rest] -> - case constraint_member(componentrelation,Cons) of - {true,{_,{_,_,ObjectSet},AtList}} -> + case lists:keyfind(componentrelation, 1, Cons) of + {_,{_,_,ObjectSet},AtList} -> %% This AtList must have an "outermost" at sign to be %% relevent here. [{_,AL=[#'Externalvaluereference'{value=_Attr}|_R1]}|_R2] @@ -6036,7 +6030,7 @@ innertype_comprel1(S,T = #type{def=Def,constraint=Cons,tablecinf=TCI},Path) -> lists:map(fun(#'Externalvaluereference'{value=V})->V end, AL), [{ObjectSet,AtPath,ClassDef,Path}]; - _ -> + false -> innertype_comprel(S,Def,Path) end, case Ret of -- cgit v1.2.3 From 6a72b71b69f1a41166cb6984607cca7bbbe38f43 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 3 Nov 2014 15:35:47 +0100 Subject: Clean up matching of parameters Introduce match_parameter/2 for matching a single parameter and match_parameters/2 for matching all of them. --- lib/asn1/src/asn1ct_check.erl | 82 +++++++++++++++++++++---------------------- 1 file changed, 41 insertions(+), 41 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 5533525fa9..318564df93 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -564,9 +564,7 @@ check_class(S = #state{mname=M,tname=T},ClassSpec) {pt,ClassRef,Params} -> %% parameterized class {_,PClassDef} = get_referenced_type(S,ClassRef), - NewParaList = - [match_parameters(S,TmpParam,S#state.parameters)|| - TmpParam <- Params], + NewParaList = match_parameters(S, Params), instantiate_pclass(S,PClassDef,NewParaList) end; check_class(S, #objectclass{}=C) -> @@ -844,9 +842,7 @@ check_object(S, NewOS); #type{def={pt,DefinedObjSet,ParamList}} -> {_,PObjSetDef} = get_referenced_type(S,DefinedObjSet), - NewParamList = - [match_parameters(S,TmpParam,S#state.parameters)|| - TmpParam <- ParamList], + NewParamList = match_parameters(S, ParamList), instantiate_pos(S,ClassRef,PObjSetDef,NewParamList); %% actually this is an ObjectSetFromObjects construct, it @@ -888,9 +884,7 @@ check_object(S, OS2; {pos,{objectset,_,DefinedObjSet},Params} -> {_,PObjSetDef} = get_referenced_type(S,DefinedObjSet), - NewParamList = - [match_parameters(S,TmpParam,S#state.parameters)|| - TmpParam <- Params], + NewParamList = match_parameters(S, Params), instantiate_pos(S,ClassRef,PObjSetDef,NewParamList); Unknown -> exit({error,{unknown_object_set,Unknown},S}) @@ -1246,8 +1240,7 @@ check_object_list(S,ClassRef,[ObjOrSet|Objs],Acc) -> set=OSDef}), check_object_list(S,ClassRef,Objs,Set ++ Acc); {pv,{simpledefinedvalue,DefinedObject},Params} -> - Args = [match_parameters(S,Param,S#state.parameters)|| - Param<-Params], + Args = match_parameters(S, Params), #'Object'{def=Def} = check_object(S,ObjOrSet, #'Object'{classname=ClassRef , @@ -2881,7 +2874,7 @@ check_type(_S,Type,Ts) when is_record(Type,typedef), Ts; check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> {Def,Tag,Constr,IsInlined} = - case match_parameters(S,Ts#type.def,S#state.parameters) of + case match_parameter(S, Ts#type.def) of #type{tag=PTag,constraint=_Ctmp,def=Dtmp,inlined=Inl} -> {Dtmp,merge_tags(Ts#type.tag,PTag),Ts#type.constraint,Inl}; #typedef{typespec=#type{tag=PTag,def=Dtmp,inlined=Inl}} -> @@ -3163,9 +3156,7 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> %% calling function. {_RefMod,Ptypedef} = get_referenced_type(S,Ptype), notify_if_not_ptype(S,Ptypedef), - NewParaList = - [match_parameters(S,TmpParam,S#state.parameters)|| - TmpParam <- ParaList], + NewParaList = match_parameters(S, ParaList), Instance = instantiate_ptype(S,Ptypedef,NewParaList), TempNewDef#newt{type=Instance#type.def, tag=merge_tags(Tag,Instance#type.tag), @@ -3599,7 +3590,7 @@ resolve_tuple_or_list(S, HostType, {Lb,Ub}) -> %% is replaced by the actual value %% resolve_value(S, HostType, Val) -> - Id = match_parameters(S,Val, S#state.parameters), + Id = match_parameter(S, Val), resolve_value1(S, HostType, Id). resolve_value1(S, HostType, #'Externalvaluereference'{value=Name}=ERef) -> @@ -3720,7 +3711,7 @@ check_constraint(S, HostType, {simpletable,Type}) -> {'SingleValue',ObjRef = #'Externalvaluereference'{}} -> ObjRef end, - C = match_parameters(S,Def,S#state.parameters), + C = match_parameter(S, Def), case C of #'Externaltypereference'{} -> ERef = check_externaltypereference(S,C), @@ -3766,7 +3757,7 @@ check_constraint(S, HostType, {simpletable,Type}) -> check_constraint(S, _HostType, {componentrelation,{objectset,Opos,Objset},Id}) -> %% Objset is an 'Externaltypereference' record, since Objset is %% a DefinedObjectSet. - RealObjset = match_parameters(S,Objset,S#state.parameters), + RealObjset = match_parameter(S, Objset), ObjSetRef = case RealObjset of #'Externaltypereference'{} -> RealObjset; @@ -4365,8 +4356,8 @@ get_referenced_type(S, T, Recurse) -> Res end. -do_get_referenced_type(#state{parameters=Ps}=S, T0) -> - case match_parameters(S, T0, Ps) of +do_get_referenced_type(S, T0) -> + case match_parameter(S, T0) of T0 -> do_get_ref_type_1(S, T0); T -> @@ -4584,34 +4575,43 @@ get_importmoduleoftype([I|Is],Name) -> get_importmoduleoftype([],_) -> undefined. +match_parameters(S, Names) -> + [match_parameter(S, Name) || Name <- Names]. -match_parameters(_S,Name,[]) -> - Name; +match_parameter(#state{parameters=Ps}=S, Name) -> + match_parameter(S, Name, Ps). -match_parameters(_S,#'Externaltypereference'{type=Name},[{#'Externaltypereference'{type=Name},NewName}|_T]) -> +match_parameter(_S, Name, []) -> + Name; +match_parameter(_S, #'Externaltypereference'{type=Name}, + [{#'Externaltypereference'{type=Name},NewName}|_T]) -> NewName; -match_parameters(_S,#'Externaltypereference'{type=Name},[{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) -> +match_parameter(_S, #'Externaltypereference'{type=Name}, + [{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) -> NewName; -match_parameters(_S,#'Externalvaluereference'{value=Name},[{#'Externalvaluereference'{value=Name},NewName}|_T]) -> +match_parameter(_S, #'Externalvaluereference'{value=Name}, + [{#'Externalvaluereference'{value=Name},NewName}|_T]) -> NewName; -match_parameters(_S,#'Externalvaluereference'{value=Name},[{{_,#'Externalvaluereference'{value=Name}},NewName}|_T]) -> +match_parameter(_S, #'Externalvaluereference'{value=Name}, + [{{_,#'Externalvaluereference'{value=Name}},NewName}|_T]) -> NewName; -match_parameters(_S,#type{def=#'Externaltypereference'{module=M,type=Name}}, - [{#'Externaltypereference'{module=M,type=Name},Type}]) -> +match_parameter(_S, #type{def=#'Externaltypereference'{module=M,type=Name}}, + [{#'Externaltypereference'{module=M,type=Name},Type}]) -> Type; -match_parameters(_S,{valueset,#type{def=#'Externaltypereference'{type=Name}}}, - [{{_,#'Externaltypereference'{type=Name}},{valueset,#type{def=NewName}}}|_T]) -> +match_parameter(_S, {valueset,#type{def=#'Externaltypereference'{type=Name}}}, + [{{_,#'Externaltypereference'{type=Name}}, + {valueset,#type{def=NewName}}}|_T]) -> NewName; -match_parameters(_S,{valueset,#type{def=#'Externaltypereference'{type=Name}}}, - [{{_,#'Externaltypereference'{type=Name}}, - NewName=#type{def=#'Externaltypereference'{}}}|_T]) -> +match_parameter(_S, {valueset,#type{def=#'Externaltypereference'{type=Name}}}, + [{{_,#'Externaltypereference'{type=Name}}, + NewName=#type{def=#'Externaltypereference'{}}}|_T]) -> NewName#type.def; -match_parameters(_S,{valueset,#type{def=#'Externaltypereference'{type=Name}}}, - [{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) -> +match_parameter(_S, {valueset,#type{def=#'Externaltypereference'{type=Name}}}, + [{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) -> NewName; %% When a parameter is a parameterized element it has to be %% instantiated now! -match_parameters(S,{valueset,T=#type{def={pt,_,_Args}}},_Parameters) -> +match_parameter(S, {valueset,T=#type{def={pt,_,_Args}}}, _Ps) -> case catch check_type(S,#typedef{name=S#state.tname,typespec=T},T) of pobjectsetdef -> @@ -4638,11 +4638,11 @@ match_parameters(S,{valueset,T=#type{def={pt,_,_Args}}},_Parameters) -> Ts when is_record(Ts,type) -> Ts#type.def end; %% same as previous, only depends on order of parsing -match_parameters(S,{valueset,{pos,{objectset,_,POSref},Args}},Parameters) -> - match_parameters(S,{valueset,#type{def={pt,POSref,Args}}},Parameters); -match_parameters(S,Name, [_H|T]) -> - %%io:format("match_parameters(~p,~p)~n",[Name,[H|T]]), - match_parameters(S,Name,T). +match_parameter(S, {valueset,{pos,{objectset,_,POSref},Args}}, Ps) -> + match_parameter(S, {valueset,#type{def={pt,POSref,Args}}}, Ps); +match_parameter(S, Name, [_H|T]) -> + %%io:format("match_parameter(~p,~p)~n",[Name,[H|T]]), + match_parameter(S, Name, T). imported(S,Name) -> {imports,Ilist} = (S#state.module)#module.imports, -- cgit v1.2.3 From d17a84df58177143c89180aeb85373e0d5504210 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 3 Nov 2014 15:51:40 +0100 Subject: Correct another bug with instantiated types a1260b2ffa60581ce3af0728320b593cca3fd7b0 fixed a problem with expansion of parameterized types, but it didn't go all the way. The compiler would still crash if we attempted to define a value using the instantiated type. --- lib/asn1/src/asn1ct_check.erl | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 318564df93..cb94b2efba 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -3163,9 +3163,11 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> constraint=Instance#type.constraint, inlined=yes}; - OCFT=#'ObjectClassFieldType'{classname=ClRef} -> + #'ObjectClassFieldType'{classname=ClRef0}=OCFT0 -> %% this case occures in a SEQUENCE when %% the type of the component is a ObjectClassFieldType + ClRef = match_parameter(S, ClRef0), + OCFT = OCFT0#'ObjectClassFieldType'{classname=ClRef}, ClassSpec = check_class(S,ClRef), NewTypeDef = maybe_open_type(S,ClassSpec, -- cgit v1.2.3 From 6d9725178dd44aa0337901b081be93113f988167 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 31 Oct 2014 15:22:40 +0100 Subject: Clean up and correct table constraint handling --- lib/asn1/src/asn1ct_check.erl | 84 ++++++++++++++++++++++--------------------- 1 file changed, 43 insertions(+), 41 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index cb94b2efba..42bf0c2751 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -3184,9 +3184,11 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> case TopName of [] when Type#typedef.name =/= undefined -> %% This is a top-level type. - #type{def=Simplified} = - simplify_type(#type{def=NewTypeDef}), - TempNewDef#newt{type=Simplified,tag=Ct}; + #type{constraint=C,def=Simplified} = + simplify_type(#type{def=NewTypeDef, + constraint=Constr}), + TempNewDef#newt{type=Simplified,tag=Ct, + constraint=C}; _ -> TempNewDef#newt{type=NewTypeDef,tag=Ct} end; @@ -3232,10 +3234,11 @@ simplify_comp(#'ComponentType'{typespec=Type0}=C) -> C#'ComponentType'{typespec=Type}; simplify_comp(Other) -> Other. -simplify_type(#type{tag=Tag,def=Inner}=T) -> +simplify_type(#type{tag=Tag,def=Inner,constraint=Constr0}=T) -> case Inner of - #'ObjectClassFieldType'{type={fixedtypevaluefield,_,Type}} -> - Type#type{tag=Tag}; + #'ObjectClassFieldType'{type={fixedtypevaluefield,_,Type}}=OCFT -> + Constr = [{ocft,OCFT}|Type#type.constraint++Constr0], + Type#type{tag=Tag,constraint=Constr}; _ -> T end. @@ -5680,7 +5683,7 @@ remove_doubles1(El,L) -> NewL -> remove_doubles1(El,NewL) end. -%% get_simple_table_info searches the commponents Cs by the path from +%% get_simple_table_info searches the components Cs by the path from %% an at-list (third argument), and follows into a component of it if %% necessary, to get information needed for code generating. %% @@ -5695,32 +5698,35 @@ remove_doubles1(El,L) -> % %% at least one step below the outermost level, i.e. the leading % %% information shall be on a sub level. 2) They don't have any common % %% path. -get_simple_table_info(S,Cs,[AtList|Rest]) -> - [get_simple_table_info1(S,Cs,AtList,[])|get_simple_table_info(S,Cs,Rest)]; -get_simple_table_info(_,_,[]) -> - []. -get_simple_table_info1(S,Cs,[Cname|Cnames],Path) when is_list(Cs) -> - case lists:keysearch(Cname,#'ComponentType'.name,Cs) of - {value,C} -> - get_simple_table_info1(S,C,Cnames,[Cname|Path]); - _ -> - error({type,"Missing expected simple table constraint",S}) - end; -get_simple_table_info1(S,#'ComponentType'{typespec=TS},[],Path) -> - %% In this component there must be a simple table constraint - %% o.w. the asn1 code is wrong. - #type{def=OCFT,constraint=Cnstr} = TS, - case lists:keymember(simpletable, 1, Cnstr) of +get_simple_table_info(S, Cs, AtLists) -> + [get_simple_table_info1(S, Cs, AtList, []) || AtList <- AtLists]. + +get_simple_table_info1(S, Cs, [Cname|Cnames], Path) -> + #'ComponentType'{} = C = + lists:keyfind(Cname, #'ComponentType'.name, Cs), + get_simple_table_info2(S, C, Cnames, [Cname|Path]). + +get_simple_table_info2(S, #'ComponentType'{name=Name,typespec=TS}, [], Path) -> + OCFT = simple_table_get_ocft(S, Name, TS), + case lists:keymember(simpletable, 1, TS#type.constraint) of true -> - simple_table_info(S,OCFT,Path); + simple_table_info(S, OCFT, Path); false -> - error({type,{"missing expected simple table constraint", - Cnstr},S}) + asn1_error(S, {missing_table_constraint,Name}) end; -get_simple_table_info1(S,#'ComponentType'{typespec=TS},Cnames,Path) -> +get_simple_table_info2(S, #'ComponentType'{typespec=TS}, Cnames, Path) -> Components = get_atlist_components(TS#type.def), - get_simple_table_info1(S,Components,Cnames,Path). - + get_simple_table_info1(S, Components, Cnames, Path). + +simple_table_get_ocft(_, _, #type{def=#'ObjectClassFieldType'{}=OCFT}) -> + OCFT; +simple_table_get_ocft(S, Component, #type{constraint=Constr}) -> + case lists:keyfind(ocft, 1, Constr) of + {ocft,OCFT} -> + OCFT; + false -> + asn1_error(S, {missing_ocft,Component}) + end. simple_table_info(S,#'ObjectClassFieldType'{classname=ClRef, class=ObjectClass, @@ -5752,10 +5758,7 @@ simple_table_info(S,#'ObjectClassFieldType'{classname=ClRef, error({type,{internal_error,Msg},S}); {Other,_} -> Other end, - {lists:reverse(Path),ObjectClassFieldName,UniqueName}; -simple_table_info(S,Type,_) -> - error({type,{"the type referenced by a componentrelation constraint must be a ObjectClassFieldType",Type},S}). - + {lists:reverse(Path),ObjectClassFieldName,UniqueName}. %% any_component_relation searches for all component relation %% constraints that refers to the actual level and returns a list of @@ -5908,14 +5911,8 @@ get_choice_components(S,ERef=#'Externaltypereference'{}) -> #typedef{typespec=TS} = TypeDef, get_choice_components(S,TS#type.def). -extract_at_notation([{Level,[#'Externalvaluereference'{value=Name}|Rest]}]) -> - {Level,[Name|extract_at_notation1(Rest)]}; -extract_at_notation(At) -> - exit({error,{asn1,{at_notation,At}}}). -extract_at_notation1([#'Externalvaluereference'{value=Name}|Rest]) -> - [Name|extract_at_notation1(Rest)]; -extract_at_notation1([]) -> - []. +extract_at_notation([{Level,ValueRefs}]) -> + {Level,[Name || #'Externalvaluereference'{value=Name} <- ValueRefs]}. %% componentrelation1/1 identifies all componentrelation constraints %% that exist in C or in the substructure of C. Info about the found @@ -6532,6 +6529,11 @@ format_error({invalid_bit_number,Bit}) -> format_error({missing_mandatory_fields,Fields,Obj}) -> io_lib:format("missing mandatory ~s in ~p", [format_fields(Fields),Obj]); +format_error({missing_table_constraint,Component}) -> + io_lib:format("the component '~s' is referenced by a component relation constraint using the '@field-name' notation, but does not have a table constraint", + [Component]); +format_error({missing_ocft,Component}) -> + io_lib:format("the component '~s' must be an ObjectClassFieldType (CLASSNAME.&field-name)", [Component]); format_error({namelist_redefinition,Name}) -> io_lib:format("the name '~s' can not be redefined", [Name]); format_error({syntax_duplicated_fields,Fields}) -> -- cgit v1.2.3 From 1b8e14c290d1b7fb8b89b3139ab10c4623afb031 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 5 Nov 2014 12:53:34 +0100 Subject: Clean up handling ObjectClassFieldType --- lib/asn1/src/asn1ct_check.erl | 70 +++++++------------------------------------ 1 file changed, 11 insertions(+), 59 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 42bf0c2751..8b184108ac 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -3313,18 +3313,21 @@ merged_mod(S,RefMod,Ext) -> %% any UNIQUE field, so that a component relation constraint cannot specify %% the type of a typefield, return 'ASN1_OPEN_TYPE'. %% -maybe_open_type(S,ClassSpec=#objectclass{fields=Fs}, - OCFT=#'ObjectClassFieldType'{fieldname=FieldRefList}, +maybe_open_type(_, _, #'ObjectClassFieldType'{fieldname={_,_}}=OCFT, _) -> + %% Already converted. + OCFT; +maybe_open_type(S, #objectclass{fields=Fs}=ClassSpec, + #'ObjectClassFieldType'{fieldname=FieldRefList}=OCFT, Constr) -> - Type = get_ObjectClassFieldType(S,Fs,FieldRefList), - FieldNames=get_referenced_fieldname(FieldRefList), - case last_fieldname(FieldRefList) of + Type = get_OCFType(S, Fs, FieldRefList), + FieldNames = get_referenced_fieldname(FieldRefList), + case lists:last(FieldRefList) of {valuefieldreference,_} -> OCFT#'ObjectClassFieldType'{fieldname=FieldNames, type=Type}; {typefieldreference,_} -> case {catch get_unique_fieldname(S,#classdef{typespec=ClassSpec}), - asn1ct_gen:get_constraint(Constr,componentrelation)}of + asn1ct_gen:get_constraint(Constr, componentrelation)} of {Tuple,_} when tuple_size(Tuple) =:= 3 -> OCFT#'ObjectClassFieldType'{fieldname=FieldNames, type='ASN1_OPEN_TYPE'}; @@ -3337,17 +3340,6 @@ maybe_open_type(S,ClassSpec=#objectclass{fields=Fs}, end end. -last_fieldname(FieldRefList) when is_list(FieldRefList) -> - lists:last(FieldRefList); -last_fieldname({FieldName,_}) when is_atom(FieldName) -> - [A|_] = atom_to_list(FieldName), - case is_lowercase(A) of - true -> - {valuefieldreference,FieldName}; - _ -> - {typefieldreference,FieldName} - end. - is_open_type(#'ObjectClassFieldType'{type='ASN1_OPEN_TYPE'}) -> true; is_open_type(#'ObjectClassFieldType'{}) -> @@ -3527,11 +3519,6 @@ parameter_name_style(#'Externaltypereference'{}) -> parameter_name_style(#'Externalvaluereference'{}) -> beginning_lowercase. -is_lowercase(X) when X >= $A,X =< $W -> - false; -is_lowercase(_) -> - true. - %% categorize(Parameter) -> CategorizedParameter %% If Parameter has an abstract syntax of another category than %% Category, transform it to a known syntax. @@ -6196,31 +6183,8 @@ get_tableconstraint_info(S,Type,[C|Cs],Acc) -> get_referenced_fieldname([{_,FirstFieldname}]) -> {FirstFieldname,[]}; -get_referenced_fieldname([{_,FirstFieldname}|Rest]) -> - {FirstFieldname,lists:map(fun(X)->element(2,X) end,Rest)}; -get_referenced_fieldname(Def={FieldName,RestFieldName}) when is_atom(FieldName),is_list(RestFieldName)-> - Def; -get_referenced_fieldname(Def) -> - {no_type,Def}. - -%% get_ObjectClassFieldType extracts the type from the chain of -%% objects that leads to a final type. -get_ObjectClassFieldType(S,ERef,PrimFieldNameList) when - is_record(ERef,'Externaltypereference') -> - {MName,Type} = get_referenced_type(S,ERef), - NewS = update_state(S#state{type=Type, - tname=ERef#'Externaltypereference'.type},MName), - ClassSpec = check_class(NewS,Type), - Fields = ClassSpec#objectclass.fields, - get_ObjectClassFieldType(S,Fields,PrimFieldNameList); -get_ObjectClassFieldType(S,Fields,L=[_PrimFieldName1|_Rest]) -> - check_PrimitiveFieldNames(S,Fields,L), - get_OCFType(S,Fields,L); -get_ObjectClassFieldType(S,ERef,{FieldName,Rest}) -> - get_ObjectClassFieldType(S,ERef,Rest ++ [FieldName]). - -check_PrimitiveFieldNames(_S,_Fields,_) -> - ok. +get_referenced_fieldname([{_,FirstFieldname}|T]) -> + {FirstFieldname,[element(2, X) || X <- T]}. %% get_ObjectClassFieldType_classdef gets the def of the class of the %% ObjectClassFieldType, i.e. the objectclass record. If the type has @@ -6281,18 +6245,6 @@ get_taglist(_S,#'ObjectClassFieldType'{type={typefield,_}}) -> []; get_taglist(S,#'ObjectClassFieldType'{type={fixedtypevaluefield,_,Type}}) -> get_taglist(S,Type); -get_taglist(S,{ERef=#'Externaltypereference'{},FieldNameList}) - when is_list(FieldNameList) -> - case get_ObjectClassFieldType(S,ERef,FieldNameList) of - {fixedtypevaluefield,_,Type} -> get_taglist(S,Type); - {TypeFieldName,_} when is_atom(TypeFieldName) -> []%should check if allowed - end; -get_taglist(S,{ObjCl,FieldNameList}) when is_record(ObjCl,objectclass), - is_list(FieldNameList) -> - case get_ObjectClassFieldType(S,ObjCl#objectclass.fields,FieldNameList) of - {fixedtypevaluefield,_,Type} -> get_taglist(S,Type); - {TypeFieldName,_} when is_atom(TypeFieldName) -> []%should check if allowed - end; get_taglist(_, _) -> []. -- cgit v1.2.3 From fa8dfc8aa8ae99526a3dc1faa2baaadff51117fb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 6 Nov 2014 13:04:52 +0100 Subject: Rewrite handling of ObjectSetFromObjects The ObjectSetFromObjects construct is implemented using the object_set_from_objects() function, which is similar to get_fieldname_element(). Rewrite the ObjectSetFromObjects handling to use get_fieldname_element() to share more code. --- lib/asn1/src/asn1ct_check.erl | 259 +++++++++++------------------------------- 1 file changed, 66 insertions(+), 193 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 8b184108ac..000f4668d3 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -850,38 +850,14 @@ check_object(S, %% field. #type{def=#'ObjectClassFieldType'{classname=ObjName, fieldname=FieldName}} -> - {RefedObjMod,TDef} = get_referenced_type(S,ObjName), - OS=TDef#typedef.typespec, - %% should get the right object set here. Get the field - %% FieldName out of the object set OS of class - %% OS#'ObjectSet'.class - OS2=check_object(S,TDef,OS), - NewSet=object_set_from_objects(S,RefedObjMod,FieldName,OS2), - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, - set=NewSet}; + NewSet = check_ObjectSetFromObjects(S, ObjName, FieldName, []), + ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, set=NewSet}; {'ObjectSetFromObjects',{_,_,ObjName},FieldName} -> - {RefedObjMod,TDef} = get_referenced_type(S,ObjName), - OS=TDef#typedef.typespec, - %% should get the right object set here. Get the field - %% FieldName out of the object set OS of class - %% OS#'ObjectSet'.class - OS2=check_object(S,TDef,OS), - NewSet=object_set_from_objects(S,RefedObjMod,FieldName,OS2), - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, - set=NewSet}; - {'ObjectSetFromObjects',{_,ObjName},FieldName} -> - %% This is a ObjectSetFromObjects, i.e. - %% ObjectSetFromObjects ::= ReferencedObjects "." FieldName - %% with a defined object as ReferencedObjects. And - %% the FieldName of the Class (object) contains an object set. - {RefedObjMod,TDef} = get_referenced_type(S,ObjName), - O1 = TDef#typedef.typespec, - O2 = check_object(S,TDef,O1), - NewSet = object_set_from_objects(S,RefedObjMod,FieldName,O2), - OS2=ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, - set=NewSet}, - %%io:format("ObjectSet: ~p~n",[OS2]), - OS2; + NewSet = check_ObjectSetFromObjects(S, ObjName, FieldName, []), + ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, set=NewSet}; + {'ObjectSetFromObjects',{_,ObjName},FieldName} -> + NewSet = check_ObjectSetFromObjects(S, ObjName, FieldName, []), + ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, set=NewSet}; {pos,{objectset,_,DefinedObjSet},Params} -> {_,PObjSetDef} = get_referenced_type(S,DefinedObjSet), NewParamList = match_parameters(S, Params), @@ -1034,135 +1010,6 @@ prepare_objset({#type{}=Type,#type{}=Ext}) -> prepare_objset(Ret) -> Ret. -%% ObjectSetFromObjects functionality - -%% The fieldname is a list of field names.They may be objects or -%% object sets. If ObjectSet is an object set the resulting object set -%% is the union of object sets if the last field name is an object -%% set. If the last field is an object the resulting object set is -%% the set of objects in ObjectSet. -object_set_from_objects(S,RefedObjMod,FieldName,ObjectSet) -> - object_set_from_objects(S,RefedObjMod,FieldName,ObjectSet,[]). -object_set_from_objects(S,RefedObjMod,FieldName,ObjectSet,InterSect) - when is_record(ObjectSet,'ObjectSet') -> - #'ObjectSet'{class=Cl,set=Set} = ObjectSet, - {_,ClassDef} = get_referenced_type(S,Cl), - object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,Set,InterSect,[]); -object_set_from_objects(S,RefedObjMod,FieldName,Object,InterSect) - when is_record(Object,'Object') -> - #'Object'{classname=Cl,def=Def}=Object, - object_set_from_objects(S,RefedObjMod,Cl,FieldName,[Def],InterSect,[]). -object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,['EXTENSIONMARK'|Os], - InterSect,Acc) -> - object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,Os,InterSect,%%Acc); - ['EXTENSIONMARK'|Acc]); -object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,[O|Os],InterSect,Acc) -> - case object_set_from_objects2(S,mod_of_obj(RefedObjMod,element(1,O)), - ClassDef,FieldName,element(3,O),InterSect) of - ObjS when is_list(ObjS) -> - object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,Os,InterSect,ObjS++Acc); - Obj -> - object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,Os,InterSect,[Obj|Acc]) - end; -object_set_from_objects(S,_RefedObjMod,_ClassDef,_FieldName,[],InterSect,Acc) -> - %% For instance may Acc contain objects of same class from - %% different object sets that in fact might be duplicates. - Set = osfo_intersection(InterSect,Acc), - remove_duplicate_objects(S, Set). - -object_set_from_objects2(S,RefedObjMod,ClassDef,[{valuefieldreference,OName}], - Fields,_InterSect) -> - %% this is an object - case lists:keysearch(OName,1,Fields) of - {value,{_,TDef}} -> - mk_object_set_from_object(S,RefedObjMod,TDef,ClassDef); - _ -> - [] % it may be an absent optional field - end; -object_set_from_objects2(S,RefedObjMod,ClassDef,[{typefieldreference,OSName}], - Fields,_InterSect) -> - %% this is an object set - case lists:keysearch(OSName,1,Fields) of - {value,{_,TDef}} -> - case TDef#typedef.typespec of - #'ObjectSet'{class=_NextClName,set=NextSet} ->%% = TDef#typedef.typespec, - NextSet; - #'Object'{def=_ObjDef} -> - mk_object_set_from_object(S,RefedObjMod,TDef,ClassDef) -%% ObjDef - %% error({error,{internal,unexpected_object,TDef}}) - end; - _ -> - [] % it may be an absent optional field - end; -object_set_from_objects2(S,RefedObjMod,_ClassDef,[{valuefieldreference,OName}|Rest], - Fields,InterSect) -> - %% this is an object - case lists:keysearch(OName,1,Fields) of - {value,{_,TDef}} -> - #'Object'{classname=NextClName,def=ODef}=TDef#typedef.typespec, - {_,_,NextFields}=ODef, - {_,NextClass} = get_referenced_type(S,NextClName), - object_set_from_objects2(S,RefedObjMod,NextClass,Rest,NextFields,InterSect); - _ -> - [] - end; -object_set_from_objects2(S,RefedObjMod,_ClassDef,[{typefieldreference,OSName}|Rest], - Fields,InterSect) -> - %% this is an object set - Next = {NextClName,NextSet} = - case lists:keysearch(OSName,1,Fields) of - {value,{_,TDef}} when is_record(TDef,'ObjectSet') -> - #'ObjectSet'{class=NextClN,set=NextS} = TDef, - {NextClN,NextS}; - {value,{_,#typedef{typespec=OS}}} -> - %% objectsets in defined syntax will come here as typedef{} - %% #'ObjectSet'{class=NextClN,set=NextS} = OS, - case OS of - #'ObjectSet'{class=NextClN,set=NextS} -> - {NextClN,NextS}; - #'Object'{classname=NextClN,def=NextDef} -> - {NextClN,[NextDef]} - end; - _ -> - {[],[]} - end, - case Next of - {[],[]} -> - []; - _ -> - {_,NextClass} = get_referenced_type(S,NextClName), - object_set_from_objects(S,RefedObjMod,NextClass,Rest,NextSet,InterSect,[]) - end. - -mk_object_set_from_object(S,RefedObjMod,TDef,Class) -> - #'Object'{classname=_NextClName,def=ODef} = TDef#typedef.typespec, - {_,_,NextFields}=ODef, - - UniqueFieldName = - case (catch get_unique_fieldname(S,Class)) of - {error,'__undefined_',_} -> {unique,undefined}; - {asn1,Msg,_} -> error({class,Msg,S}); - {'EXIT',Msg} -> error({class,{internal_error,Msg},S}); - {Other,_} -> Other - end, - VDef = get_unique_value(S,NextFields,UniqueFieldName), - %% XXXXXXXXXXX - case VDef of - [] -> - ['EXTENSIONMARK']; - _ -> - {{RefedObjMod,get_datastr_name(TDef)},VDef,NextFields} - end. - - -mod_of_obj(_RefedObjMod,{NewMod,ObjName}) - when is_atom(NewMod),is_atom(ObjName) -> - NewMod; -mod_of_obj(RefedObjMod,_) -> - RefedObjMod. - - merge_sets(Root,{'SingleValue',Ext}) -> merge_sets(Root,Ext); merge_sets(Root,Ext) when is_list(Root),is_list(Ext) -> @@ -1253,13 +1100,10 @@ check_object_list(S,ClassRef,[ObjOrSet|Objs],Acc) -> FieldName,[]), check_object_list(S,ClassRef,Objs,NewSet++Acc); {{'ObjectSetFromObjects',Os,FieldName},InterSection} - when is_tuple(Os) -> - NewSet = - check_ObjectSetFromObjects(S, element(tuple_size(Os), Os), - FieldName,InterSection), - check_object_list(S,ClassRef,Objs,NewSet++Acc); - Other -> - exit({error,{'unknown object',Other},S}) + when is_tuple(Os) -> + Set = check_ObjectSetFromObjects(S, element(tuple_size(Os), Os), + FieldName, InterSection), + check_object_list(S, ClassRef, Objs, Set++Acc) end; %% Finally reverse the accumulated list and if there are any extension %% marks in the object set put one indicator of that in the end of the @@ -1282,11 +1126,21 @@ check_referenced_object(S,ObjRef) check_object(update_state(S,RefedMod),ObjectDef,ObjectDef#typedef.typespec)} end. -check_ObjectSetFromObjects(S,ObjName,FieldName,InterSection) -> - {RefedMod,TDef} = get_referenced_type(S,ObjName), - ObjOrSet = check_object(update_state(S,RefedMod),TDef,TDef#typedef.typespec), - InterSec = prepare_intersection(S,InterSection), - _NewSet = object_set_from_objects(S,RefedMod,FieldName,ObjOrSet,InterSec). +check_ObjectSetFromObjects(S, ObjName, Fields, InterSection) -> + {_,Obj0} = get_referenced_type(S, ObjName), + Objs = case check_object(S, Obj0, Obj0#typedef.typespec) of + #'ObjectSet'{}=Obj1 -> + get_fieldname_set(S, Obj1, Fields); + #'Object'{classname=Class, + def={object,_,ObjFs}} -> + ObjSet = #'ObjectSet'{class=Class, + set=[{'_','_',ObjFs}]}, + get_fieldname_set(S, ObjSet, Fields) + end, + InterSec = prepare_intersection(S, InterSection), + Set = osfo_intersection(InterSec, Objs), + remove_duplicate_objects(S, Set). + prepare_intersection(_S,[]) -> []; @@ -1349,28 +1203,46 @@ extract_field(S, Def0, FieldNames) -> %% element. The list of field name tuples may have more than one element. %% All field names but the last refers to either an object or object set. -get_fieldname_element(S, #typedef{}=Def, [{_RefType,FieldName}]) -> - Object = (Def#typedef.typespec)#'Object'.def, - check_fieldname_element(S, FieldName, Object); -get_fieldname_element(S, #typedef{}=Def, [{_RefType,FieldName}|T]) -> - %% As FieldName is followed by other FieldNames it has to be an - %% object or objectset. - Object = (Def#typedef.typespec)#'Object'.def, +get_fieldname_element(S, Object0, [{_RefType,FieldName}|Fields]) -> + Object = case Object0 of + #typedef{typespec=#'Object'{def=Obj}} -> Obj; + {_,_,_}=Obj -> Obj + end, case check_fieldname_element(S, FieldName, Object) of - #'Object'{def=D} -> - get_fieldname_element(S, D, T); - #'ObjectSet'{set=Set0} -> - Set = [get_fieldname_element(S, X, T) || X <- Set0], - get_fieldname_return_set(Set) + #'Object'{def=D} when Fields =/= [] -> + get_fieldname_element(S, D, Fields); + #'ObjectSet'{}=Set -> + get_fieldname_set(S, Set, Fields); + Result when Fields =:= [] -> + Result end; -get_fieldname_element(S, {_,_,_}=Object, [{_RefType,FieldName}|T]) -> - Def = check_fieldname_element(S, FieldName, Object), - get_fieldname_element(S, Def, T); get_fieldname_element(_S, Def, []) -> Def. -get_fieldname_return_set([#valuedef{}|_]=L) -> - {valueset,L}. +get_fieldname_set(S, #'ObjectSet'{set=Set0}, T) -> + get_fieldname_set_1(S, Set0, T, []). + +get_fieldname_set_1(S, ['EXTENSIONMARK'=Ext|T], Fields, Acc) -> + get_fieldname_set_1(S, T, Fields, [Ext|Acc]); +get_fieldname_set_1(S, [H|T], Fields, Acc) -> + try get_fieldname_element(S, H, Fields) of + L when is_list(L) -> + get_fieldname_set_1(S, T, Fields, L++Acc); + {valueset,L} -> + get_fieldname_set_1(S, T, Fields, L++Acc); + Other -> + get_fieldname_set_1(S, T, Fields, [Other|Acc]) + catch + throw:{error,_} -> + get_fieldname_set_1(S, T, Fields, Acc) + end; +get_fieldname_set_1(_, [], _Fields, Acc) -> + case Acc of + [#valuedef{}|_] -> + {valueset,Acc}; + _ -> + Acc + end. check_fieldname_element(S, Name, {_,_,Fields}) -> case lists:keyfind(Name, 1, Fields) of @@ -1905,10 +1777,11 @@ match_syntax_objset_1(S, {setting,_,Set}, ClassDef) -> match_syntax_objset_1(S, {word_or_setting,_,Set}, ClassDef) -> %% Word in uppercase/hyphens only. match_syntax_objset(S, Set, ClassDef); -match_syntax_objset_1(S, #type{def={'TypeFromObject', - {object,Object}, - FieldNames}}, _) -> - #typedef{checked=true,typespec=extract_field(S, Object, FieldNames)}; +match_syntax_objset_1(S, #type{def={'TypeFromObject', {object,Object}, FNs}}, + ClassDef) -> + Set = extract_field(S, Object, FNs), + [_|_] = Set, + #typedef{checked=true,typespec=#'ObjectSet'{class=ClassDef,set=Set}}; match_syntax_objset_1(_, #type{def=#'ObjectClassFieldType'{}}=Set, ClassDef) -> make_objset(ClassDef, Set). -- cgit v1.2.3 From 1ba5c4caefe9d44266e8675e6a991280dddffde6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 11 Nov 2014 15:09:27 +0100 Subject: Fix several levels of inlined definitions --- lib/asn1/src/asn1ct_check.erl | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 000f4668d3..b80697f805 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -1783,7 +1783,9 @@ match_syntax_objset_1(S, #type{def={'TypeFromObject', {object,Object}, FNs}}, [_|_] = Set, #typedef{checked=true,typespec=#'ObjectSet'{class=ClassDef,set=Set}}; match_syntax_objset_1(_, #type{def=#'ObjectClassFieldType'{}}=Set, ClassDef) -> - make_objset(ClassDef, Set). + make_objset(ClassDef, Set); +match_syntax_objset_1(_, {object,_,_}=Object, ClassDef) -> + make_objset(ClassDef, [Object]). make_objset(ClassDef, Set) -> #typedef{typespec=#'ObjectSet'{class=ClassDef,set=Set}}. -- cgit v1.2.3 From ad5b931714295640ff117d23aeb8f691e9cc8a55 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 12 Nov 2014 14:42:00 +0100 Subject: Clean up checking of object sets --- lib/asn1/src/asn1ct_check.erl | 502 ++++++++++++++-------------------------- lib/asn1/src/asn1ct_parser2.erl | 4 +- 2 files changed, 180 insertions(+), 326 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index b80697f805..2955f55b60 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -747,6 +747,13 @@ check_pobjectset(S,PObjSet) -> PObjSet end. +-record(osi, %Object set information. + {st, + classref, + uniq, + ext + }). + check_object(_S,ObjDef,ObjSpec) when (ObjDef#typedef.checked == true) -> ObjSpec; check_object(S,_ObjDef,#'Object'{classname=ClassRef,def=ObjectDef}) -> @@ -791,15 +798,9 @@ check_object(S,_ObjDef,#'Object'{classname=ClassRef,def=ObjectDef}) -> Fields = (ClassDef#classdef.typespec)#objectclass.fields, Gen = gen_incl(S,NewObj#'Object'.def, Fields), NewObj#'Object'{classname=NewClassRef,gen=Gen}; - - -check_object(S, - _ObjSetDef, - ObjSet=#'ObjectSet'{class=ClassRef}) -> -%% io:format("check_object,SET: ~p~n",[ObjSet#'ObjectSet'.set]), - ?dbg("check_object set: ~p~n",[ObjSet#'ObjectSet'.set]), - {_,ClassDef} = get_referenced_type(S,ClassRef), - NewClassRef = check_externaltypereference(S,ClassRef), +check_object(S, _, #'ObjectSet'{class=ClassRef0,set=Set0}=ObjSet0) -> + {_,ClassDef} = get_referenced_type(S, ClassRef0), + ClassRef = check_externaltypereference(S, ClassRef0), {UniqueFieldName,UniqueInfo} = case (catch get_unique_fieldname(S,ClassDef)) of {error,'__undefined_',_} -> @@ -808,89 +809,172 @@ check_object(S, {'EXIT',Msg} -> error({class,{internal_error,Msg},S}); Other -> {element(1,Other),Other} end, - NewObjSet= - case prepare_objset(ObjSet#'ObjectSet'.set) of - {set,SET,EXT} -> - CheckedSet = check_object_list(S,NewClassRef,SET), - NewSet = get_unique_valuelist(S,CheckedSet,UniqueInfo), - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, - set=extensionmark(NewSet,EXT)}; - - {'SingleValue',ERef = #'Externalvaluereference'{}} -> - {RefedMod,ObjDef} = get_referenced_type(S,ERef), - #'Object'{def=CheckedObj} = - check_object(S, ObjDef, object_to_check(ObjDef)), - NewSet = get_unique_valuelist(S,[{{RefedMod,get_datastr_name(ObjDef)}, - CheckedObj}], - UniqueInfo), - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, - set=NewSet}; - ['EXTENSIONMARK'] -> - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, - set=['EXTENSIONMARK']}; - - OSref when is_record(OSref,'Externaltypereference') -> - {_,OS=#typedef{typespec=OSdef}} = get_referenced_type(S,OSref), - check_object(S,OS,OSdef); - - {Type,{'EXCEPT',Exclusion}} when is_record(Type,type) -> - {_,TDef} = get_referenced_type(S,Type#type.def), - OS = TDef#typedef.typespec, - NewSet = reduce_objectset(OS#'ObjectSet'.set,Exclusion), - NewOS = OS#'ObjectSet'{set=NewSet}, - check_object(S,TDef#typedef{typespec=NewOS}, - NewOS); - #type{def={pt,DefinedObjSet,ParamList}} -> - {_,PObjSetDef} = get_referenced_type(S,DefinedObjSet), - NewParamList = match_parameters(S, ParamList), - instantiate_pos(S,ClassRef,PObjSetDef,NewParamList); - - %% actually this is an ObjectSetFromObjects construct, it - %% is when the object set is retrieved from an object - %% field. - #type{def=#'ObjectClassFieldType'{classname=ObjName, - fieldname=FieldName}} -> - NewSet = check_ObjectSetFromObjects(S, ObjName, FieldName, []), - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, set=NewSet}; - {'ObjectSetFromObjects',{_,_,ObjName},FieldName} -> - NewSet = check_ObjectSetFromObjects(S, ObjName, FieldName, []), - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, set=NewSet}; - {'ObjectSetFromObjects',{_,ObjName},FieldName} -> - NewSet = check_ObjectSetFromObjects(S, ObjName, FieldName, []), - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, set=NewSet}; - {pos,{objectset,_,DefinedObjSet},Params} -> - {_,PObjSetDef} = get_referenced_type(S,DefinedObjSet), - NewParamList = match_parameters(S, Params), - instantiate_pos(S,ClassRef,PObjSetDef,NewParamList); - Unknown -> - exit({error,{unknown_object_set,Unknown},S}) - end, - NewSet2 = remove_duplicate_objects(S, NewObjSet#'ObjectSet'.set), - NewObjSet2 = NewObjSet#'ObjectSet'{set=NewSet2}, - Gen = gen_incl_set(S,NewObjSet2#'ObjectSet'.set, - ClassDef), - ?dbg("check_object done~n",[]), - NewObjSet2#'ObjectSet'{class=NewClassRef,gen=Gen}. + OSI0 = #osi{st=S,classref=ClassRef,uniq=UniqueInfo,ext=false}, + {Set1,OSI1} = if + is_list(Set0) -> + check_object_set_list(Set0, OSI0); + true -> + check_object_set(Set0, OSI0) + end, + Ext = case Set1 of + [] -> + %% FIXME: X420 does not compile unless we force + %% empty sets to be extensible. There should be + %% a better way. + true; + [_|_] -> + OSI1#osi.ext + end, + Set2 = remove_duplicate_objects(S, Set1), + Set = case Ext of + false -> Set2; + true -> Set2 ++ ['EXTENSIONMARK'] + end, + ObjSet = ObjSet0#'ObjectSet'{uniquefname=UniqueFieldName,set=Set}, + Gen = gen_incl_set(S, Set, ClassDef), + ObjSet#'ObjectSet'{class=ClassRef,gen=Gen}. + +check_object_set(#'Externaltypereference'{}=Ref, #osi{st=S}=OSI) -> + {_,#typedef{typespec=OSdef}=OS} = get_referenced_type(S, Ref), + ObjectSet = check_object(S, OS, OSdef), + check_object_set_objset(ObjectSet, OSI); +check_object_set(#'Externalvaluereference'{}=Ref, #osi{st=S}=OSI) -> + {RefedMod,ObjName,#'Object'{def=Def}} = check_referenced_object(S, Ref), + ObjList = check_object_set_mk(RefedMod, ObjName, Def, OSI), + {ObjList,OSI}; +check_object_set({'EXCEPT',Incl0,Excl0}, OSI) -> + {Incl1,_} = check_object_set(Incl0, OSI), + {Excl1,_} = check_object_set(Excl0, OSI), + Exclude = sofs:set([N || {N,_} <- Excl1], [name]), + Incl2 = [{Name,Obj} || {Name,_,_}=Obj <- Incl1], + Incl3 = sofs:relation(Incl2, [{name,object}]), + Incl4 = sofs:drestriction(Incl3, Exclude), + Incl5 = sofs:to_external(Incl4), + Incl = [Obj || {_,Obj} <- Incl5], + {Incl,OSI}; +check_object_set('EXTENSIONMARK', OSI) -> + {[],OSI#osi{ext=true}}; +check_object_set({object,_,_}=Obj0, OSI) -> + #osi{st=S,classref=ClassRef} = OSI, + #'Object'{def=Def} = + check_object(S, #typedef{typespec=Obj0}, + #'Object'{classname=ClassRef,def=Obj0}), + ObjList = check_object_set_mk(Def, OSI), + {ObjList,OSI}; +check_object_set(#'ObjectClassFieldType'{classname=ObjName, + fieldname=FieldNames}, + #osi{st=S}=OSI) -> + Set = check_ObjectSetFromObjects(S, ObjName, FieldNames), + check_object_set_objset_list(Set, OSI); +check_object_set({'ObjectSetFromObjects',Obj,FieldNames}, #osi{st=S}=OSI) -> + ObjName = element(tuple_size(Obj), Obj), + Set = check_ObjectSetFromObjects(S, ObjName, FieldNames), + check_object_set_objset_list(Set, OSI); +check_object_set({pt,DefinedObjSet,ParamList0}, OSI) -> + #osi{st=S,classref=ClassRef} = OSI, + {_,PObjSetDef} = get_referenced_type(S, DefinedObjSet), + ParamList = match_parameters(S, ParamList0), + ObjectSet = instantiate_pos(S, ClassRef, PObjSetDef, ParamList), + check_object_set_objset(ObjectSet, OSI); +check_object_set({pos,{objectset,_,DefinedObjSet},Params0}, OSI) -> + #osi{st=S,classref=ClassRef} = OSI, + {_,PObjSetDef} = get_referenced_type(S, DefinedObjSet), + Params = match_parameters(S, Params0), + ObjectSet = instantiate_pos(S, ClassRef, PObjSetDef, Params), + check_object_set_objset(ObjectSet, OSI); +check_object_set({pv,{simpledefinedvalue,DefinedObject},Params}=PV, OSI) -> + #osi{st=S,classref=ClassRef} = OSI, + Args = match_parameters(S, Params), + #'Object'{def=Def} = + check_object(S, PV, + #'Object'{classname=ClassRef , + def={po,{object,DefinedObject},Args}}), + ObjList = check_object_set_mk(Def, OSI), + {ObjList,OSI}; +check_object_set({'SingleValue',Set}, OSI) when is_list(Set) -> + check_object_set_list(Set, OSI); +check_object_set({'SingleValue',Val}, OSI) -> + check_object_set(Val, OSI); +check_object_set({{'SingleValue',Root},Ext}, OSI) -> + Set = merge_sets(Root, Ext), + check_object_set_list(Set, OSI#osi{ext=true}); +check_object_set({'ValueFromObject',{object,Object},FieldNames}, OSI) -> + #osi{st=S} = OSI, + case extract_field(S, Object, FieldNames) of + #'Object'{def=Def} -> + ObjList = check_object_set_mk(Def, OSI), + {ObjList,OSI}; + _ -> + asn1_error(S, illegal_object) + end; +check_object_set(#type{def=Def}, OSI) -> + check_object_set(Def, OSI); +check_object_set(union, OSI) -> + {[],OSI}; +check_object_set({Root,Ext}, OSI) -> + Set = merge_sets(Root, Ext), + check_object_set_list(Set, OSI#osi{ext=true}). + +check_object_set_list([H|T], OSI0) -> + {Set0,OSI1} = check_object_set(H, OSI0), + {Set1,OSI2} = check_object_set_list(T, OSI1), + {Set0++Set1,OSI2}; +check_object_set_list([], OSI) -> + {[],OSI}. + +check_object_set_objset(#'ObjectSet'{set=Set}, OSI) -> + check_object_set_objset_list(Set, OSI). + +check_object_set_objset_list(Set, OSI) -> + check_object_set_objset_list_1(Set, OSI, []). + +check_object_set_objset_list_1(['EXTENSIONMARK'|T], OSI, Acc) -> + check_object_set_objset_list_1(T, OSI#osi{ext=true}, Acc); +check_object_set_objset_list_1([H|T], OSI, Acc) -> + check_object_set_objset_list_1(T, OSI, [H|Acc]); +check_object_set_objset_list_1([], OSI, Acc) -> + {Acc,OSI}. + +check_object_set_mk(Fields, OSI) -> + check_object_set_mk(no_mod, no_name, Fields, OSI). + +check_object_set_mk(M, N, Def, #osi{uniq={unique,undefined}}) -> + {_,_,Fields} = Def, + [{{M,N},no_unique_value,Fields}]; +check_object_set_mk(M, N, Def, #osi{uniq={UniqField,_}}) -> + {_,_,Fields} = Def, + case lists:keyfind(UniqField, 1, Fields) of + {UniqField,#valuedef{value=Val}} -> + [{{M,N},Val,Fields}]; + false -> + case Fields of + [{_,#typedef{typespec=#'ObjectSet'{set=['EXTENSIONMARK']}}}] -> + %% FIXME: If object is missing the unique field and + %% only contains a reference to an empty object set, + %% we will remove the entire object as a workaround + %% to get X420 to compile. There should be a better + %% way. + []; + _ -> + [{{M,N},no_unique_value,Fields}] + end + end. %% remove_duplicate_objects/1 remove duplicates of objects. %% For instance may Set contain objects of same class from %% different object sets that in fact might be duplicates. remove_duplicate_objects(S, Set0) when is_list(Set0) -> - Set1 = lists:map(fun({_,Id,_}=Orig) -> - {{a,Id},Orig}; - ('EXTENSIONMARK'=Ext) -> - {{z,Ext},Ext} - end, Set0), + Set1 = [{Id,Orig} || {_,Id,_}=Orig <- Set0], Set2 = sofs:relation(Set1), Set3 = sofs:relation_to_family(Set2), Set = sofs:to_external(Set3), remove_duplicate_objects_1(S, Set). -remove_duplicate_objects_1(S, [{{a,no_unique_value},Objs}|T]) -> +remove_duplicate_objects_1(S, [{no_unique_value,Objs}|T]) -> Objs ++ remove_duplicate_objects_1(S, T); remove_duplicate_objects_1(S, [{_,[_]=Objs}|T]) -> Objs ++ remove_duplicate_objects_1(S, T); -remove_duplicate_objects_1(S, [{{_,Id},[_|_]=Objs}|T]) -> +remove_duplicate_objects_1(S, [{Id,[_|_]=Objs}|T]) -> MakeSortable = fun(What) -> sortable_type(S, What) end, Tagged = order_tag_set(Objs, MakeSortable), case lists:ukeysort(1, Tagged) of @@ -971,15 +1055,6 @@ traverse_seq_set_1([{'COMPONENTS OF', _} = CO0|Cs], Fun) -> traverse_seq_set_1([], _) -> []. -%% -extensionmark(L,true) -> - case lists:member('EXTENSIONMARK',L) of - true -> L; - _ -> L ++ ['EXTENSIONMARK'] - end; -extensionmark(L,_) -> - L. - object_to_check(#typedef{typespec=ObjDef}) -> ObjDef; object_to_check(#valuedef{type=ClassName,value=ObjectRef}) -> @@ -987,129 +1062,13 @@ object_to_check(#valuedef{type=ClassName,value=ObjectRef}) -> %% is parsed as a type #'Object'{classname=ClassName#type.def,def=ObjectRef}. -prepare_objset({'SingleValue',Set}) when is_list(Set) -> - {set,Set,false}; -prepare_objset(L=['EXTENSIONMARK']) -> - L; -prepare_objset(Set) when is_list(Set) -> - {set,Set,false}; -prepare_objset({{'SingleValue',Set},Ext}) -> - {set,merge_sets(Set,Ext),true}; -%%prepare_objset({Set,Ext}) when is_list(Set),is_list(Ext) -> -%% {set,lists:append([Set,Ext]),true}; -prepare_objset({Set,Ext}) when is_list(Set) -> - {set,merge_sets(Set,Ext),true}; -prepare_objset({{object,definedsyntax,_ObjFields}=Set,Ext}) -> - {set,merge_sets(Set, Ext),true}; -prepare_objset(ObjDef={object,definedsyntax,_ObjFields}) -> - {set,[ObjDef],false}; -prepare_objset({ObjDef=#type{},Ext}) when is_list(Ext) -> - {set,[ObjDef|Ext],true}; -prepare_objset({#type{}=Type,#type{}=Ext}) -> - {set,[Type,Ext],true}; -prepare_objset(Ret) -> - Ret. - -merge_sets(Root,{'SingleValue',Ext}) -> - merge_sets(Root,Ext); -merge_sets(Root,Ext) when is_list(Root),is_list(Ext) -> - Root ++ Ext; -merge_sets(Root,Ext) when is_list(Ext) -> - [Root|Ext]; -merge_sets(Root,Ext) when is_list(Root) -> - Root++[Ext]; -merge_sets(Root,Ext) -> - [Root]++[Ext]. - -reduce_objectset(ObjectSet,Exclusion) -> - case Exclusion of - {'SingleValue',#'Externalvaluereference'{value=Name}} -> - case lists:keysearch(Name,1,ObjectSet) of - {value,El} -> - lists:subtract(ObjectSet,[El]); - _ -> - ObjectSet - end +merge_sets(Root, Ext) -> + case {is_list(Root),is_list(Ext)} of + {false,false} -> [Root,Ext]; + {false,true} -> [Root|Ext]; + {true,false} -> Root ++ [Ext]; + {true,true} -> Root ++ Ext end. - -%% Checks a list of objects or object sets and returns a list of selected -%% information for the code generation. -check_object_list(S,ClassRef,ObjectList) -> - check_object_list(S,ClassRef,ObjectList,[]). - -check_object_list(S,ClassRef,[ObjOrSet|Objs],Acc) -> - ?dbg("check_object_list: ~p~n",[ObjOrSet]), - case ObjOrSet of - ObjDef when is_tuple(ObjDef),(element(1,ObjDef)==object) -> - Def = - check_object(S,#typedef{typespec=ObjDef}, -% #'Object'{classname={objectclassname,ClassRef}, - #'Object'{classname=ClassRef, - def=ObjDef}), - check_object_list(S,ClassRef,Objs,[{{no_mod,no_name},Def#'Object'.def}|Acc]); - {'SingleValue',Ref = #'Externalvaluereference'{}} -> - ?dbg("{SingleValue,Externalvaluereference}~n",[]), - {RefedMod,ObjName, - #'Object'{def=Def}} = check_referenced_object(S,Ref), - check_object_list(S,ClassRef,Objs,[{{RefedMod,ObjName},Def}|Acc]); - ObjRef when is_record(ObjRef,'Externalvaluereference') -> - ?dbg("Externalvaluereference~n",[]), - {RefedMod,ObjName, - #'Object'{def=Def}} = check_referenced_object(S,ObjRef), - check_object_list(S,ClassRef,Objs,[{{RefedMod,ObjName},Def}|Acc]); - {'ValueFromObject',{object,Object},FieldNames} -> - case extract_field(S, Object, FieldNames) of - #'Object'{def=Def} -> - check_object_list(S, ClassRef, Objs, - [{{no_mod,no_name},Def}|Acc]); - _ -> - asn1_error(S, illegal_object) - end; - ObjSet when is_record(ObjSet,type) -> - ObjSetDef = - case ObjSet#type.def of - Ref when is_record(Ref,'Externaltypereference') -> - {_,D} = get_referenced_type(S,ObjSet#type.def), - D; - Other -> - throw({asn1_error,{'unknown objecset',Other,S}}) - end, - #'ObjectSet'{set=ObjectsInSet} = - check_object(S,ObjSetDef,ObjSetDef#typedef.typespec), - AccList = transform_set_to_object_list(ObjectsInSet,[]), - check_object_list(S,ClassRef,Objs,AccList++Acc); - union -> - check_object_list(S,ClassRef,Objs,Acc); - {pos,{objectset,_,DefinedObjectSet},Params} -> - OSDef = #type{def={pt,DefinedObjectSet,Params}}, - #'ObjectSet'{set=Set} = - check_object(S,ObjOrSet,#'ObjectSet'{class=ClassRef, - set=OSDef}), - check_object_list(S,ClassRef,Objs,Set ++ Acc); - {pv,{simpledefinedvalue,DefinedObject},Params} -> - Args = match_parameters(S, Params), - #'Object'{def=Def} = - check_object(S,ObjOrSet, - #'Object'{classname=ClassRef , - def={po,{object,DefinedObject}, - Args}}), - check_object_list(S,ClassRef,Objs,[{{no_mod,no_name},Def}|Acc]); - {'ObjectSetFromObjects',Os,FieldName} when is_tuple(Os) -> - NewSet = - check_ObjectSetFromObjects(S, element(tuple_size(Os), Os), - FieldName,[]), - check_object_list(S,ClassRef,Objs,NewSet++Acc); - {{'ObjectSetFromObjects',Os,FieldName},InterSection} - when is_tuple(Os) -> - Set = check_ObjectSetFromObjects(S, element(tuple_size(Os), Os), - FieldName, InterSection), - check_object_list(S, ClassRef, Objs, Set++Acc) - end; -%% Finally reverse the accumulated list and if there are any extension -%% marks in the object set put one indicator of that in the end of the -%% list. -check_object_list(_,_,[],Acc) -> - lists:reverse(Acc). check_referenced_object(S,ObjRef) when is_record(ObjRef,'Externalvaluereference')-> @@ -1126,41 +1085,16 @@ check_referenced_object(S,ObjRef) check_object(update_state(S,RefedMod),ObjectDef,ObjectDef#typedef.typespec)} end. -check_ObjectSetFromObjects(S, ObjName, Fields, InterSection) -> +check_ObjectSetFromObjects(S, ObjName, Fields) -> {_,Obj0} = get_referenced_type(S, ObjName), - Objs = case check_object(S, Obj0, Obj0#typedef.typespec) of - #'ObjectSet'{}=Obj1 -> - get_fieldname_set(S, Obj1, Fields); - #'Object'{classname=Class, - def={object,_,ObjFs}} -> - ObjSet = #'ObjectSet'{class=Class, - set=[{'_','_',ObjFs}]}, - get_fieldname_set(S, ObjSet, Fields) - end, - InterSec = prepare_intersection(S, InterSection), - Set = osfo_intersection(InterSec, Objs), - remove_duplicate_objects(S, Set). - - -prepare_intersection(_S,[]) -> - []; -prepare_intersection(S,{'EXCEPT',ObjRef}) -> - except_names(S,ObjRef); -prepare_intersection(_S,T) -> - exit({error,{internal_error,not_implemented,object_set_from_objects,T}}). -except_names(_S,{'SingleValue',#'Externalvaluereference'{value=ObjName}}) -> - [{except,ObjName}]; -except_names(_,T) -> - exit({error,{internal_error,not_implemented,object_set_from_objects,T}}). - -osfo_intersection(InterSect,ObjList) -> - Res = [X|| X = {{_,N},_,_} <- ObjList, - lists:member({except,N},InterSect) == false], - case lists:member('EXTENSIONMARK',ObjList) of - true -> - Res ++ ['EXTENSIONMARK']; - _ -> - Res + case check_object(S, Obj0, Obj0#typedef.typespec) of + #'ObjectSet'{}=Obj1 -> + get_fieldname_set(S, Obj1, Fields); + #'Object'{classname=Class, + def={object,_,ObjFs}} -> + ObjSet = #'ObjectSet'{class=Class, + set=[{'_','_',ObjFs}]}, + get_fieldname_set(S, ObjSet, Fields) end. %% get_type_from_object(State, ObjectOrObjectSet, [{RefType,FieldName}]) -> @@ -1279,86 +1213,6 @@ check_fieldname_element_1(S, Eref) {_,TDef} = get_referenced_type(S, Eref), check_fieldname_element_1(S, TDef). -transform_set_to_object_list([{Name,_UVal,Fields}|Objs],Acc) -> - transform_set_to_object_list(Objs,[{Name,{object,generatesyntax,Fields}}|Acc]); -transform_set_to_object_list(['EXTENSIONMARK'|Objs],Acc) -> -%% transform_set_to_object_list(Objs,['EXTENSIONMARK'|Acc]); - transform_set_to_object_list(Objs,Acc); -transform_set_to_object_list([],Acc) -> - Acc. - -get_unique_valuelist(_S,ObjSet,{unique,undefined}) -> % no unique field in object - lists:map(fun({N,{_,_,F}})->{N,no_unique_value,F}; - (V={_,_,_}) ->V; - ({A,B}) -> {A,no_unique_value,B} - end, ObjSet); -get_unique_valuelist(S,ObjSet,{UFN,Opt}) -> - get_unique_vlist(S,ObjSet,UFN,Opt,[]). - - -get_unique_vlist(_S,[],_,_,[]) -> - ['EXTENSIONMARK']; -get_unique_vlist(_, [], _, _Opt, Acc) -> - lists:reverse(Acc); -get_unique_vlist(S,['EXTENSIONMARK'|Rest],UniqueFieldName,Opt,Acc) -> - get_unique_vlist(S,Rest,UniqueFieldName,Opt,Acc); -get_unique_vlist(S,[{ObjName,Obj}|Rest],UniqueFieldName,Opt,Acc) -> - {_,_,Fields} = Obj, - NewObjInf = - case get_unique_value(S,Fields,UniqueFieldName) of - #valuedef{value=V} -> [{ObjName,V,Fields}]; - [] -> []; % maybe the object only was a reference to an - % empty object set. - no_unique_value -> [{ObjName,no_unique_value,Fields}] - end, - get_unique_vlist(S,Rest,UniqueFieldName,Opt,NewObjInf++Acc); - -get_unique_vlist(S,[V={_,_,_}|Rest],UniqueFieldName,Opt,Acc) -> - get_unique_vlist(S,Rest,UniqueFieldName,Opt,[V|Acc]). - -get_unique_value(S,Fields,UniqueFieldName) -> - Module = S#state.mname, - case lists:keysearch(UniqueFieldName,1,Fields) of - {value,Field} -> - case element(2,Field) of - VDef when is_record(VDef,valuedef) -> - VDef; - {'ValueFromObject',Object,Name} -> - case Object of - {object,Ext} when is_record(Ext,'Externaltypereference') -> - OtherModule = Ext#'Externaltypereference'.module, - ExtObjName = Ext#'Externaltypereference'.type, - ObjDef = asn1_db:dbget(OtherModule,ExtObjName), - ObjSpec = ObjDef#typedef.typespec, - get_unique_value(OtherModule,element(3,ObjSpec),Name); - {object,{_,_,ObjName}} -> - ObjDef = asn1_db:dbget(Module,ObjName), - ObjSpec = ObjDef#typedef.typespec, - get_unique_value(Module,element(3,ObjSpec),Name); - {po,Object,_Params} -> - exit({error,{'parameterized object not implemented yet', - Object},S}) - end; - Value when is_atom(Value);is_number(Value) -> - #valuedef{value=Value,module=Module}; - {'CHOICE',{C,Value}} when is_atom(C) -> - %% #valuedef{value=normalize_value(S,element(3,Field),VDef,[])} - case Value of - Scalar when is_atom(Scalar);is_number(Scalar) -> - #valuedef{value=Value,module=Module}; - Eref = #'Externalvaluereference'{} -> - element(2,get_referenced_type(S,Eref)) - end - end; - false -> - case Fields of - [{_,#typedef{typespec=#'ObjectSet'{set=['EXTENSIONMARK']}}}] -> - []; - _ -> - no_unique_value - end - end. - %% instantiate_po/4 %% ClassDef is the class of Object, %% Object is the Parameterized object, which is referenced, diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl index bcfa779997..9b2fc0b046 100644 --- a/lib/asn1/src/asn1ct_parser2.erl +++ b/lib/asn1/src/asn1ct_parser2.erl @@ -893,7 +893,7 @@ parse_ElementSetSpecs(Tokens) -> parse_ElementSetSpec([{'ALL',_},{'EXCEPT',_}|Rest]) -> {Exclusions,Rest2} = parse_Elements(Rest), - {{'ALL',{'EXCEPT',Exclusions}},Rest2}; + {{'ALL-EXCEPT',Exclusions},Rest2}; parse_ElementSetSpec(Tokens) -> parse_Unions(Tokens). @@ -983,7 +983,7 @@ parse_IntersectionElements(Tokens) -> case Rest of [{'EXCEPT',_}|Rest2] -> {Exclusion,Rest3} = parse_Elements(Rest2), - {{InterSec,{'EXCEPT',Exclusion}},Rest3}; + {{'EXCEPT',InterSec,Exclusion},Rest3}; Rest -> {InterSec,Rest} end. -- cgit v1.2.3 From 7339da14195d1eeac133be8b9b7287ac8b577114 Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Fri, 14 Nov 2014 11:57:39 +0100 Subject: asn1: Minor bug fixes Fixes needed to avoid a compiling asn1 files in order. For example the x420 directory in test now compiles with erlc *.asn Do not save class records without module information in asn1db files. Use recursive get_referenced_type in get_objclass_fields/2 --- lib/asn1/src/asn1ct_check.erl | 41 ++++++++++++++++++++++++----------------- 1 file changed, 24 insertions(+), 17 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 2955f55b60..568855a42d 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -438,24 +438,31 @@ do_checkc(S, Name, Class) -> do_checkc_1(S, Name, Class) end. -do_checkc_1(S0, Name, Class0) -> - {Class1,ClassSpec} = - case Class0 of - #classdef{} -> - {Class0,Class0}; - #typedef{} -> - {#classdef{name=Name},Class0#typedef.typespec} - end, - S = S0#state{type=Class0,tname=Name}, - try check_class(S, ClassSpec) of +do_checkc_1(S, Name, #classdef{}=Class) -> + try check_class(S, Class) of + C -> + store_class(S, true, Class#classdef{typespec=C}, Name), + ok + catch + {error,Reason} -> + error({class,Reason,S}) + end; +do_checkc_1(S, Name, #typedef{typespec=#type{def=Def}=TS}) -> + try check_class(S, TS) of C -> - Class = Class1#classdef{checked=true,typespec=C}, - asn1_db:dbput(S#state.mname, Name, Class), + {Mod,Pos} = case Def of + #'Externaltypereference'{module=M, pos=P} -> + {M,P}; + {pt, #'Externaltypereference'{module=M, pos=P}, _} -> + {M,P} + end, + Class = #classdef{name=Name, typespec=C, pos=Pos, module=Mod}, + store_class(S, true, Class, Name), ok - catch - {error,Reason} -> - error({class,Reason,S}) - end. + catch + {error,Reason} -> + error({class,Reason,S}) + end. %% is_classname(Atom) -> true|false. is_classname(Name) when is_atom(Name) -> @@ -1296,7 +1303,7 @@ gen_incl1(S,Fields,[C|CFields]) -> end. get_objclass_fields(S,Eref=#'Externaltypereference'{}) -> - {_,ClassDef} = get_referenced_type(S,Eref), + {_,ClassDef} = get_referenced_type(S,Eref, true), get_objclass_fields(S,ClassDef); get_objclass_fields(S,CD=#classdef{typespec=#'Externaltypereference'{}}) -> get_objclass_fields(S,CD#classdef.typespec); -- cgit v1.2.3 From 73de3847eee629cacf441fd6e6d8781ff80569cb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 19 Nov 2014 12:04:24 +0100 Subject: asn1ct_constructed_per: Remove useless argument 'NeedRest' NeedRest was introduced in df7bb30f, for unknown reasons (my guess is that the argument was needed at some point during the development of the commit). Found by dialyzer. --- lib/asn1/src/asn1ct_constructed_per.erl | 21 +++++++-------------- 1 file changed, 7 insertions(+), 14 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl index 83c0acae17..0bc6688a49 100644 --- a/lib/asn1/src/asn1ct_constructed_per.erl +++ b/lib/asn1/src/asn1ct_constructed_per.erl @@ -569,10 +569,10 @@ gen_encode_sof_imm(Erule, Typename, SeqOrSetOf, #type{}=D) -> gen_decode_sof(Erules, Typename, SeqOrSetOf, #type{}=D) -> asn1ct_name:start(), - do_gen_decode_sof(Erules, Typename, SeqOrSetOf, D, true), + do_gen_decode_sof(Erules, Typename, SeqOrSetOf, D), emit([".",nl,nl]). -do_gen_decode_sof(Erules, Typename, SeqOrSetOf, D, NeedRest) -> +do_gen_decode_sof(Erules, Typename, SeqOrSetOf, D) -> {_SeqOrSetOf,ComponentType} = D#type.def, SizeConstraint = asn1ct_imm:effective_constraint(bitstring, D#type.constraint), @@ -584,12 +584,11 @@ do_gen_decode_sof(Erules, Typename, SeqOrSetOf, D, NeedRest) -> "" end, {Num,Buf} = gen_decode_length(SizeConstraint, Erules), - Key = erlang:md5(term_to_binary({Typename,SeqOrSetOf, - ComponentType,NeedRest})), + Key = erlang:md5(term_to_binary({Typename,SeqOrSetOf,ComponentType})), Gen = fun(_Fd, Name) -> gen_decode_sof_components(Erules, Name, Typename, SeqOrSetOf, - ComponentType, NeedRest) + ComponentType) end, F = asn1ct_func:call_gen("dec_components", Key, Gen), emit([",",nl, @@ -603,7 +602,7 @@ gen_decode_length(Constraint, Erule) -> Imm = asn1ct_imm:per_dec_length(Constraint, true, is_aligned(Erule)), asn1ct_imm:dec_slim_cg(Imm, "Bytes"). -gen_decode_sof_components(Erule, Name, Typename, SeqOrSetOf, Cont, NeedRest) -> +gen_decode_sof_components(Erule, Name, Typename, SeqOrSetOf, Cont) -> {ObjFun,ObjFun_Var} = case Cont#type.tablecinf of [{objfun,_}|_R] -> @@ -611,14 +610,8 @@ gen_decode_sof_components(Erule, Name, Typename, SeqOrSetOf, Cont, NeedRest) -> _ -> {"",""} end, - case NeedRest of - false -> - emit([{asis,Name},"(0, _Bytes",ObjFun_Var,", Acc) ->",nl, - "lists:reverse(Acc);",nl]); - true -> - emit([{asis,Name},"(0, Bytes",ObjFun_Var,", Acc) ->",nl, - "{lists:reverse(Acc),Bytes};",nl]) - end, + emit([{asis,Name},"(0, Bytes",ObjFun_Var,", Acc) ->",nl, + "{lists:reverse(Acc),Bytes};",nl]), emit([{asis,Name},"(Num, Bytes",ObjFun,", Acc) ->",nl, "{Term,Remain} = "]), Constructed_Suffix = asn1ct_gen:constructed_suffix(SeqOrSetOf, -- cgit v1.2.3 From 65edabb2b428c74702d11194847676baf4025a85 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 19 Nov 2014 12:41:23 +0100 Subject: Rewrite constraint handling The internal representation for constraints (and object sets) as produced by the parser was awkward, making further processing convoluted. Here follows some examples of the old representation for INTEGER constraints. The constraint 1..2 is represented as: {'ValueRange',{1,2}} If we extend the constraint like this: 1..2, ..., or like this: 1..2, ..., 3 the representation would be: {{'ValueRange',{1,2}},[]} and {{'ValueRange',{1,2}},{'SingleValue',3}} respectively. Note that the pattern {A,B} will match all these constraints. When combining constraints using set operators: 1..2 | 3..4 ^ 5..6 the representation will no longer be a tuple but a list: [{'ValueRange',{1..2}} union {'ValueRange',{3..4}} intersection {'ValueRange',{5..6}}] The parse has full knowledge of the operator precedence; unfortunately, the following pass (asn1ct_check) must also have the same knowledge in order to correctly evaluate the constraints. If we would change the order of the evaulation with round brackets: (1..2 | 3..4) ^ 5..6 there would be a nested listed in the representation: [[{'ValueRange',{1..2}} union {'ValueRange',{3..4}}] intersection {'ValueRange',{5..6}}] We will change the representation to make it more explicit. At the outer level, a constraint is always represented as {element_set,Root,Extension} Extension will be 'none' if there is no extension, and 'empty' if there is an empty extension. Root may also be 'empty' in an object set if there are no objects in the root. Thus the constraints: 1..2 1..2, ... 1..2, ..., 3 will be represented as: {element_set,{'ValueRange',{1,2}},none} {element_set,{'ValueRange',{1,2}},empty} {element_set,{'ValueRange',{1,2}},{'SingleValue',3}} We will change the set operators too. This constraint: 1..2 | 3..4 ^ 5..6 will be represented as: {element_set, {union, {'ValueRange',{1,2}}, {intersection, {'ValueRange',{3,4}}, {'ValueRange',{5,6}}}, none}} which is trivial to understand and evaluate. Similarly: (1..2 | 3..4) ^ 5..6 will be represented as: {element_set, {intersection, {union,{'ValueRange',{1,2}},{'ValueRange',{3,4}}}, {'ValueRange',{5,6}}}, none} --- lib/asn1/src/asn1ct_check.erl | 1184 ++++++++++++++++----------------------- lib/asn1/src/asn1ct_imm.erl | 5 + lib/asn1/src/asn1ct_parser2.erl | 166 ++---- 3 files changed, 520 insertions(+), 835 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 568855a42d..d748042df6 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -841,6 +841,18 @@ check_object(S, _, #'ObjectSet'{class=ClassRef0,set=Set0}=ObjSet0) -> Gen = gen_incl_set(S, Set, ClassDef), ObjSet#'ObjectSet'{class=ClassRef,gen=Gen}. +check_object_set({element_set,Root0,Ext0}, OSI0) -> + OSI = case Ext0 of + none -> OSI0; + _ -> OSI0#osi{ext=true} + end, + case {Root0,Ext0} of + {empty,empty} -> {[],OSI}; + {empty,Ext} -> check_object_set(Ext, OSI); + {Root,none} -> check_object_set(Root, OSI); + {Root,empty} -> check_object_set(Root, OSI); + {Root,Ext} -> check_object_set_list([Root,Ext], OSI) + end; check_object_set(#'Externaltypereference'{}=Ref, #osi{st=S}=OSI) -> {_,#typedef{typespec=OSdef}=OS} = get_referenced_type(S, Ref), ObjectSet = check_object(S, OS, OSdef), @@ -859,8 +871,6 @@ check_object_set({'EXCEPT',Incl0,Excl0}, OSI) -> Incl5 = sofs:to_external(Incl4), Incl = [Obj || {_,Obj} <- Incl5], {Incl,OSI}; -check_object_set('EXTENSIONMARK', OSI) -> - {[],OSI#osi{ext=true}}; check_object_set({object,_,_}=Obj0, OSI) -> #osi{st=S,classref=ClassRef} = OSI, #'Object'{def=Def} = @@ -898,13 +908,8 @@ check_object_set({pv,{simpledefinedvalue,DefinedObject},Params}=PV, OSI) -> def={po,{object,DefinedObject},Args}}), ObjList = check_object_set_mk(Def, OSI), {ObjList,OSI}; -check_object_set({'SingleValue',Set}, OSI) when is_list(Set) -> - check_object_set_list(Set, OSI); check_object_set({'SingleValue',Val}, OSI) -> check_object_set(Val, OSI); -check_object_set({{'SingleValue',Root},Ext}, OSI) -> - Set = merge_sets(Root, Ext), - check_object_set_list(Set, OSI#osi{ext=true}); check_object_set({'ValueFromObject',{object,Object},FieldNames}, OSI) -> #osi{st=S} = OSI, case extract_field(S, Object, FieldNames) of @@ -916,11 +921,10 @@ check_object_set({'ValueFromObject',{object,Object},FieldNames}, OSI) -> end; check_object_set(#type{def=Def}, OSI) -> check_object_set(Def, OSI); -check_object_set(union, OSI) -> - {[],OSI}; -check_object_set({Root,Ext}, OSI) -> - Set = merge_sets(Root, Ext), - check_object_set_list(Set, OSI#osi{ext=true}). +check_object_set({union,A0,B0}, OSI0) -> + {A,OSI1} = check_object_set(A0, OSI0), + {B,OSI} = check_object_set(B0, OSI1), + {A++B,OSI}. check_object_set_list([H|T], OSI0) -> {Set0,OSI1} = check_object_set(H, OSI0), @@ -1069,14 +1073,6 @@ object_to_check(#valuedef{type=ClassName,value=ObjectRef}) -> %% is parsed as a type #'Object'{classname=ClassName#type.def,def=ObjectRef}. -merge_sets(Root, Ext) -> - case {is_list(Root),is_list(Ext)} of - {false,false} -> [Root,Ext]; - {false,true} -> [Root|Ext]; - {true,false} -> Root ++ [Ext]; - {true,true} -> Root ++ Ext - end. - check_referenced_object(S,ObjRef) when is_record(ObjRef,'Externalvaluereference')-> case get_referenced_type(S,ObjRef) of @@ -1607,6 +1603,8 @@ match_syntax_external(#state{mname=Mname}=S0, Name, Ref0) -> {match,[{Name,Ref}]} end. +match_syntax_objset(_S, {element_set,_,_}=Set, ClassDef) -> + make_objset(ClassDef, Set); match_syntax_objset(S, #'Externaltypereference'{}=Ref, _) -> {_,T} = get_referenced_type(S, Ref), T; @@ -1615,10 +1613,6 @@ match_syntax_objset(S, #'Externalvaluereference'{}=Ref, _) -> T; match_syntax_objset(_, [_|_]=Set, ClassDef) -> make_objset(ClassDef, Set); -match_syntax_objset(_, {'SingleValue',_}=Set, ClassDef) -> - make_objset(ClassDef, Set); -match_syntax_objset(_, {{'SingleValue',_},_}=Set, ClassDef) -> - make_objset(ClassDef, Set); match_syntax_objset(S, {object,definedsyntax,Words}, ClassDef) -> case Words of [Word] -> @@ -1784,8 +1778,7 @@ check_value(OldS,V) when is_record(V,typedef) -> #typedef{typespec=TS} = V, case TS of #'ObjectSet'{class=ClassRef} -> - {RefM,TSDef} = get_referenced_type(OldS,ClassRef), - %%IsObjectSet(TSDef); + {_RefM,TSDef} = get_referenced_type(OldS, ClassRef), case TSDef of #classdef{} -> throw({objectsetdef}); #typedef{typespec=#type{def=Eref}} when @@ -1793,14 +1786,12 @@ check_value(OldS,V) when is_record(V,typedef) -> %% This case if the class reference is a defined %% reference to class check_value(OldS,V#typedef{typespec=TS#'ObjectSet'{class=Eref}}); - #typedef{} -> + #typedef{typespec=HostType} -> % an ordinary value set with a type in #typedef.typespec - ValueSet = TS#'ObjectSet'.set, - Type=check_type(OldS,TSDef,TSDef#typedef.typespec), - Value = check_value(OldS,#valuedef{type=Type, - value=ValueSet, - module=RefM}), - {valueset,Type#type{constraint=Value#valuedef.value}} + ValueSet0 = TS#'ObjectSet'.set, + Constr = check_constraints(OldS, HostType, [ValueSet0]), + Type = check_type(OldS,TSDef,TSDef#typedef.typespec), + {valueset,Type#type{constraint=Constr}} end; _ -> throw({objectsetdef}) @@ -2693,9 +2684,8 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> case asn1ct_gen:prim_bif(asn1ct_gen:get_inner(RefType#type.def)) of true -> %% Here we expand to a built in type and inline it - Constr2 = check_constraints(S, RefType, Constr), - NewC = constraint_merge(S, Constr2 ++ - RefType#type.constraint), + NewC = check_constraints(S, RefType, Constr ++ + RefType#type.constraint), TempNewDef#newt{ type = RefType#type.def, tag = merge_tags(Ct,RefType#type.tag), @@ -2934,8 +2924,6 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> TempNewDef#newt{tag=merge_tags(Tag,CheckedT#type.tag), type=CheckedT#type.def}; - {valueset,Vtype} -> - TempNewDef#newt{type={valueset,check_type(S,Type,Vtype)}}; {'SelectionType',Name,T} -> CheckedT = check_selectiontype(S,Name,T), TempNewDef#newt{tag=merge_tags(Tag,CheckedT#type.tag), @@ -3062,8 +3050,10 @@ maybe_open_type(S, #objectclass{fields=Fs}=ClassSpec, OCFT#'ObjectClassFieldType'{fieldname=FieldNames, type=Type}; {typefieldreference,_} -> + %% Note: The constraints have not been checked yet, + %% so we must use a special lookup routine. case {catch get_unique_fieldname(S,#classdef{typespec=ClassSpec}), - asn1ct_gen:get_constraint(Constr, componentrelation)} of + get_componentrelation(Constr)} of {Tuple,_} when tuple_size(Tuple) =:= 3 -> OCFT#'ObjectClassFieldType'{fieldname=FieldNames, type='ASN1_OPEN_TYPE'}; @@ -3076,6 +3066,13 @@ maybe_open_type(S, #objectclass{fields=Fs}=ClassSpec, end end. +get_componentrelation([{element_set,{componentrelation,_,_}=Cr,none}|_]) -> + Cr; +get_componentrelation([_|T]) -> + get_componentrelation(T); +get_componentrelation([]) -> + no. + is_open_type(#'ObjectClassFieldType'{type='ASN1_OPEN_TYPE'}) -> true; is_open_type(#'ObjectClassFieldType'{}) -> @@ -3303,15 +3300,438 @@ parse_objectset(Set) -> Set. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% check_constraints/2 -%% -check_constraints(S, T, C) when is_list(C) -> - check_constraints(S, T, C, []). +%% +%% Check and simplify constraints. +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +check_constraints(_S, _HostType, []) -> + []; +check_constraints(S, HostType0, [_|_]=Cs0) -> + HostType = get_real_host_type(HostType0, Cs0), + Cs1 = top_level_intersections(Cs0), + Cs2 = [coalesce_constraints(C) || C <- Cs1], + {_,Cs3} = filter_extensions(Cs2), + Cs = simplify_element_sets(S, HostType, Cs3), + finish_constraints(Cs). + +get_real_host_type(HostType, Cs) -> + case lists:keyfind(ocft, 1, Cs) of + false -> HostType; + {_,OCFT} -> HostType#type{def=OCFT} + end. + +top_level_intersections([{element_set,{intersection,_,_}=C,none}]) -> + top_level_intersections_1(C); +top_level_intersections(Cs) -> + Cs. + +top_level_intersections_1({intersection,A,B}) -> + [{element_set,A,none}|top_level_intersections_1(B)]; +top_level_intersections_1(Other) -> + [{element_set,Other,none}]. + +coalesce_constraints({element_set, + {Tag,{element_set,A,_}}, + {Tag,{element_set,B,_}}}) -> + %% (SIZE (C1), ..., (SIZE (C2)) => (SIZE (C1, ..., C2)) + {element_set,{Tag,{element_set,A,B}},none}; +coalesce_constraints(Other) -> + Other. + +%% Remove all outermost extensions except the last. + +filter_extensions([H0|T0]) -> + case filter_extensions(T0) of + {true,T} -> + H = remove_extension(H0), + {true,[H|T]}; + {false,T} -> + {any_extension(H0),[H0|T]} + end; +filter_extensions([]) -> + {false,[]}. + +remove_extension({element_set,Root,_}) -> + {element_set,remove_extension(Root),none}; +remove_extension(Tuple) when is_tuple(Tuple) -> + L = [remove_extension(El) || El <- tuple_to_list(Tuple)], + list_to_tuple(L); +remove_extension(Other) -> Other. + +any_extension({element_set,_,Ext}) when Ext =/= none -> + true; +any_extension(Tuple) when is_tuple(Tuple) -> + any_extension_tuple(1, Tuple); +any_extension(_) -> false. + +any_extension_tuple(I, T) when I =< tuple_size(T) -> + any_extension(element(I, T)) orelse any_extension_tuple(I+1, T); +any_extension_tuple(_, _) -> false. + +simplify_element_sets(S, HostType, [{element_set,R0,E0}|T0]) -> + R1 = simplify_element_set(S, HostType, R0), + E1 = simplify_element_set(S, HostType, E0), + case simplify_element_sets(S, HostType, T0) of + [{element_set,R2,E2}] -> + [{element_set,cs_intersection(S, R1, R2), + cs_intersection(S, E1, E2)}]; + L when is_list(L) -> + [{element_set,R1,E1}|L] + end; +simplify_element_sets(S, HostType, [H|T]) -> + [H|simplify_element_sets(S, HostType, T)]; +simplify_element_sets(_, _, []) -> + []. + +simplify_element_set(_S, _HostType, empty) -> + {set,[]}; +simplify_element_set(S, HostType, {'SingleValue',Vs0}) when is_list(Vs0) -> + Vs1 = [resolve_value(S, HostType, V) || V <- Vs0], + Vs = make_constr_set_vs(Vs1), + simplify_element_set(S, HostType, Vs); +simplify_element_set(S, HostType, {'SingleValue',V0}) -> + V1 = resolve_value(S, HostType, V0), + V = {set,[{range,V1,V1}]}, + simplify_element_set(S, HostType, V); +simplify_element_set(S, HostType, {'ValueRange',{Lb0,Ub0}}) -> + Lb = resolve_value(S, HostType, Lb0), + Ub = resolve_value(S, HostType, Ub0), + V = make_constr_set(S, Lb, Ub), + simplify_element_set(S, HostType, V); +simplify_element_set(S, HostType, {'ALL-EXCEPT',Set0}) -> + Set = simplify_element_set(S, HostType, Set0), + {'ALL-EXCEPT',Set}; +simplify_element_set(S, HostType, {intersection,A0,B0}) -> + A = simplify_element_set(S, HostType, A0), + B = simplify_element_set(S, HostType, B0), + cs_intersection(S, A, B); +simplify_element_set(S, HostType, {union,A0,B0}) -> + A = simplify_element_set(S, HostType, A0), + B = simplify_element_set(S, HostType, B0), + cs_union(S, A, B); +simplify_element_set(S, HostType, {simpletable,{element_set,Type,_}}) -> + check_simpletable(S, HostType, Type); +simplify_element_set(S, _, {componentrelation,R,Id}) -> + check_componentrelation(S, R, Id); +simplify_element_set(S, HostType, {Tag,{element_set,_,_}=El0}) -> + [El1] = simplify_element_sets(S, HostType, [El0]), + {Tag,El1}; +simplify_element_set(S, HostType, #type{}=Type) -> + simplify_element_set_type(S, HostType, Type); +simplify_element_set(_, _, C) -> + C. + +simplify_element_set_type(S, HostType, #type{def=Def0}=Type0) -> + #'Externaltypereference'{} = Def0, %Assertion. + case get_referenced_type(S, Def0) of + {_,#valuedef{checked=false,value={valueset,Vs0}}} -> + [Vs1] = simplify_element_sets(S, HostType, [Vs0]), + case Vs1 of + {element_set,Set,none} -> + Set; + {element_set,Set,{set,[]}} -> + Set + end; + {_,{valueset,#type{def=#'Externaltypereference'{}}=Type}} -> + simplify_element_set_type(S, HostType, Type); + _ -> + case HostType of + #type{def=#'ObjectClassFieldType'{}} -> + %% Open type. + #type{def=Def} = check_type(S, HostType, Type0), + Def; + _ -> + #type{constraint=Cs} = check_type(S, HostType, Type0), + C = convert_back(Cs), + simplify_element_set(S, HostType, C) + end + end. + +convert_back([H1,H2|T]) -> + {intersection,H1,convert_back([H2|T])}; +convert_back([H]) -> + H; +convert_back([]) -> + none. + +check_simpletable(S, HostType, Type) -> + case HostType of + #type{def=#'ObjectClassFieldType'{}} -> + ok; + _ -> + %% Table constraints may only be applied to + %% CLASS.&field constructs. + asn1_error(S, illegal_table_constraint) + end, + Def = case Type of + #type{def=D} -> D; + {'SingleValue',#'Externalvaluereference'{}=ObjRef} -> + ObjRef; + _ -> + asn1_error(S, invalid_table_constraint) + end, + C = match_parameter(S, Def), + case C of + #'Externaltypereference'{} -> + ERef = check_externaltypereference(S, C), + {simpletable,ERef#'Externaltypereference'.type}; + #'Externalvaluereference'{} -> + %% This is an object set with a referenced object + {_,TorVDef} = get_referenced_type(S, C), + Set = case TorVDef of + #typedef{typespec=#'Object'{classname=ClassName}} -> + #'ObjectSet'{class=ClassName, + set={'SingleValue',C}}; + #valuedef{type=#type{def=ClassDef}, + value=#'Externalvaluereference'{}=Obj} -> + %% an object might reference another object + #'ObjectSet'{class=ClassDef, + set={'SingleValue',Obj}} + end, + {simpletable,check_object(S, Type, Set)}; + {'ValueFromObject',{_,Object},FieldNames} -> + %% This is an ObjectFromObject. + {simpletable,extract_field(S, Object, FieldNames)} + end. + +check_componentrelation(S, {objectset,Opos,Objset0}, Id) -> + %% Objset is an 'Externaltypereference' record, since Objset is + %% a DefinedObjectSet. + ObjSet = match_parameter(S, Objset0), + Ext = check_externaltypereference(S, ObjSet), + {componentrelation,{objectset,Opos,Ext},Id}. + +%%% +%%% Internal set representation. +%%% +%%% We represent sets as a union of strictly disjoint ranges: +%%% +%%% {set,[Range]} +%%% +%%% A range is represented as: +%%% +%%% Range = {a_range,UpperBound} | {range,LowerBound,UpperBound} +%%% +%%% We don't use the atom 'MIN' to represent MIN, because atoms +%%% compare higher than integer. Instead we use {a_range,UpperBound} +%%% to represent MIN..UpperBound. We represent MAX as 'MAX' because +%%% 'MAX' compares higher than any integer. +%%% +%%% The ranges are sorted in term order. The ranges must not overlap +%%% or be adjacent to each other. This invariant is established when +%%% creating sets, and maintained by the intersection and union +%%% operators. +%%% +%%% Example of invalid set representaions: +%%% +%%% [{range,0,10},{range,5,10}] %Overlapping ranges +%%% [{range,0,5},{range,6,10}] %Adjancent ranges +%%% [{range,10,20},{a_range,100}] %Not sorted +%%% + +make_constr_set(_, 'MIN', Ub) -> + {set,[{a_range,make_constr_set_val(Ub)}]}; +make_constr_set(_, Lb, Ub) when Lb =< Ub -> + {set,[{range,make_constr_set_val(Lb), + make_constr_set_val(Ub)}]}; +make_constr_set(S, _, _) -> + asn1_error(S, reversed_range). + +make_constr_set_val([C]) when is_integer(C) -> C; +make_constr_set_val(Val) -> Val. + +make_constr_set_vs(Vs) -> + {set,make_constr_set_vs_1(Vs)}. + +make_constr_set_vs_1([]) -> + []; +make_constr_set_vs_1([V]) -> + [{range,V,V}]; +make_constr_set_vs_1([V0|Vs]) -> + V1 = make_constr_set_vs_1(Vs), + range_union([{range,V0,V0}], V1). + +%%% +%%% Set operators. +%%% + +cs_intersection(_S, Other, none) -> + Other; +cs_intersection(_S, none, Other) -> + Other; +cs_intersection(_S, {set,SetA}, {set,SetB}) -> + {set,range_intersection(SetA, SetB)}; +cs_intersection(_S, A, B) -> + {intersection,A,B}. + +range_intersection([], []) -> + []; +range_intersection([_|_], []) -> + []; +range_intersection([], [_|_]) -> + []; +range_intersection([H1|_]=A, [H2|_]=B) when H1 > H2 -> + range_intersection(B, A); +range_intersection([H1|T1], [H2|T2]=B) -> + %% Now H1 =< H2. + case {H1,H2} of + {{a_range,Ub0},{a_range,Ub1}} when Ub0 < Ub1 -> + %% Ub0 =/= 'MAX' + [H1|range_intersection(T1, [{range,Ub0+1,Ub1}|T2])]; + {{a_range,_},{a_range,_}} -> + %% Must be equal. + [H1|range_intersection(T1, T2)]; + {{a_range,Ub0},{range,Lb1,_Ub1}} when Ub0 < Lb1 -> + %% No intersection. + range_intersection(T1, B); + {{a_range,Ub0},{range,Lb1,Ub1}} when Ub0 < Ub1 -> + %% Ub0 =/= 'MAX' + [{range,Lb1,Ub0}|range_intersection(T1, [{range,Ub0+1,Ub1}|T2])]; + {{a_range,Ub},{range,_Lb1,Ub}} -> + %% The first range covers the second range, but does not + %% go beyond. We handle this case specially because Ub may + %% be 'MAX', and evaluating 'MAX'+1 will fail. + [H2|range_intersection(T1, T2)]; + {{a_range,Ub0},{range,_Lb1,Ub1}} -> + %% Ub0 > Ub1, Ub1 =/= 'MAX'. The first range completely + %% covers and extends beyond the second range. + [H2|range_intersection([{range,Ub1+1,Ub0}|T1], T2)]; + {{range,_Lb0,Ub0},{range,Lb1,_Ub1}} when Ub0 < Lb1 -> + %% Lb0 < Lb1. No intersection. + range_intersection(T1, B); + {{range,_Lb0,Ub0},{range,Lb1,Ub1}} when Ub0 < Ub1 -> + %% Ub0 >= Lb1, Ub0 =/= 'MAX'. Partial overlap. + [{range,Lb1,Ub0}|range_intersection(T1, [{range,Ub0+1,Ub1}|T2])]; + {{range,_Lb0,Ub},{range,_Lb1,Ub}} -> + %% The first range covers the second range, but does not + %% go beyond. We handle this case specially because Ub may + %% be 'MAX', and evaluating 'MAX'+1 will fail. + [H2|range_intersection(T1, T2)]; + {{range,_Lb0,Ub0},{range,_Lb1,Ub1}} -> + %% Ub1 =/= MAX. The first range completely covers and + %% extends beyond the second. + [H2|range_intersection([{range,Ub1+1,Ub0}|T1], T2)] + end. + +cs_union(_S, {set,SetA}, {set,SetB}) -> + {set,range_union(SetA, SetB)}; +cs_union(_S, A, B) -> + {union,A,B}. + +range_union(A, B) -> + range_union_1(lists:merge(A, B)). + +range_union_1([{a_range,Ub0},{a_range,Ub1}|T]) -> + range_union_1([{a_range,max(Ub0, Ub1)}|T]); +range_union_1([{a_range,Ub0},{range,Lb1,Ub1}|T]) when Lb1-1 =< Ub0 -> + range_union_1([{a_range,max(Ub0, Ub1)}|T]); +range_union_1([{a_range,_}=H|T]) -> + %% Ranges are disjoint. + [H|range_union_1(T)]; +range_union_1([{range,Lb0,Ub0},{range,Lb1,Ub1}|T]) when Lb1-1 =< Ub0 -> + range_union_1([{range,Lb0,max(Ub0, Ub1)}|T]); +range_union_1([{range,_,_}=H|T]) -> + %% Ranges are disjoint. + [H|range_union_1(T)]; +range_union_1([]) -> + []. + +%%% +%%% Finish up constrains, making them suitable for the back-ends. +%%% +%%% A 'PermittedAlphabet' (FROM) constraint will be reduced to: +%%% +%%% {'SingleValue',[integer()]} +%%% +%%% A 'SizeConstraint' (SIZE) constraint will be reduced to: +%%% +%%% {Lb,Ub} +%%% +%%% All other constraints will be reduced to: +%%% +%%% {'SingleValue',[integer()]} | {'ValueRange',Lb,Ub} +%%% + +finish_constraints(Cs) -> + finish_constraints_1(Cs, fun smart_collapse/1). + +finish_constraints_1([{element_set,{Tag,{element_set,_,_}=Set0},none}|T], + Collapse0) -> + Collapse = collapse_fun(Tag), + case finish_constraints_1([Set0], Collapse) of + [] -> + finish_constraints_1(T, Collapse0); + [Set] -> + [{Tag,Set}|finish_constraints_1(T, Collapse0)] + end; +finish_constraints_1([{element_set,{set,[{a_range,'MAX'}]},_}|T], Collapse) -> + finish_constraints_1(T, Collapse); +finish_constraints_1([{element_set,{intersection,A0,B0},none}|T], Collapse) -> + A = {element_set,A0,none}, + B = {element_set,B0,none}, + finish_constraints_1([A,B|T], Collapse); +finish_constraints_1([{element_set,Root,Ext}|T], Collapse) -> + case finish_constraint(Root, Ext, Collapse) of + none -> + finish_constraints_1(T, Collapse); + Constr -> + [Constr|finish_constraints_1(T, Collapse)] + end; +finish_constraints_1([H|T], Collapse) -> + [H|finish_constraints_1(T, Collapse)]; +finish_constraints_1([], _) -> + []. + +finish_constraint({set,Root0}, Ext, Collapse) -> + case Collapse(Root0) of + none -> none; + Root -> finish_constraint(Root, Ext, Collapse) + end; +finish_constraint(Root, Ext, _Collapse) -> + case Ext of + none -> Root; + _ -> {Root,[]} + end. + +collapse_fun('SizeConstraint') -> + fun size_constraint_collapse/1; +collapse_fun('PermittedAlphabet') -> + fun single_value_collapse/1. + +single_value_collapse(V) -> + {'SingleValue',ordsets:from_list(single_value_collapse_1(V))}. + +single_value_collapse_1([{range,Lb,Ub}|T]) when is_integer(Lb), + is_integer(Ub) -> + lists:seq(Lb, Ub) ++ single_value_collapse_1(T); +single_value_collapse_1([]) -> + []. -resolve_tuple_or_list(S, HostType, List) when is_list(List) -> - [resolve_value(S, HostType, X) || X <- List]; -resolve_tuple_or_list(S, HostType, {Lb,Ub}) -> - {resolve_value(S, HostType, Lb),resolve_value(S, HostType, Ub)}. +smart_collapse([{a_range,Ub}]) -> + {'ValueRange',{'MIN',Ub}}; +smart_collapse([{a_range,_}|T]) -> + {range,_,Ub} = lists:last(T), + {'ValueRange',{'MIN',Ub}}; +smart_collapse([{range,Lb,Ub}]) -> + {'ValueRange',{Lb,Ub}}; +smart_collapse([_|_]=L) -> + V = lists:foldr(fun({range,Lb,Ub}, A) -> + seq(Lb, Ub) ++ A + end, [], L), + {'SingleValue',V}. + +size_constraint_collapse([{range,0,'MAX'}]) -> + none; +size_constraint_collapse(Root) -> + [{range,Lb,_}|_] = Root, + {range,_,Ub} = lists:last(Root), + {Lb,Ub}. + +seq(Same, Same) -> + [Same]; +seq(Lb, Ub) when is_integer(Lb), is_integer(Ub) -> + lists:seq(Lb, Ub). %%%----------------------------------------- %% If the constraint value is a defined value the valuename @@ -3373,611 +3793,10 @@ resolve_namednumber_1(S, Name, NameList, Type) -> catch _:_ -> not_named end. - -check_constraints(S, HostType, [{'ContainedSubtype',Type}|T], Acc) -> - {RefMod,CTDef} = get_referenced_type(S,Type#type.def), - NewS = S#state{module=load_asn1_module(S,RefMod),mname=RefMod, - type=CTDef,tname=get_datastr_name(CTDef)}, - CType = check_type(NewS,S#state.tname,CTDef#typedef.typespec), - check_constraints(S, HostType, T, CType#type.constraint ++ Acc); -check_constraints(S, HostType, [C0|T], Acc) -> - C = check_constraint(S, HostType, C0), - check_constraints(S, HostType, T, [C|Acc]); -check_constraints(S, _, [], Acc) -> - constraint_merge(S,Acc). - - -range_check(F={FixV,FixV}) -> -% FixV; - F; -range_check(VR={Lb,Ub}) when Lb < Ub -> - VR; -range_check(Err={_,_}) -> - throw({error,{asn1,{illegal_size_constraint,Err}}}); -range_check(Value) -> - Value. - -check_constraint(S, _HostType, #'Externaltypereference'{}=Ext) -> - check_externaltypereference(S, Ext); -check_constraint(S, HostType, {'SizeConstraint',{Lb,Ub}}) - when is_list(Lb); tuple_size(Lb) =:= 2 -> - NewLb = range_check(resolve_tuple_or_list(S, HostType, Lb)), - NewUb = range_check(resolve_tuple_or_list(S, HostType, Ub)), - {'SizeConstraint',{NewLb,NewUb}}; -check_constraint(S, HostType, {'SizeConstraint',{Lb,Ub}}) -> - case {resolve_value(S, HostType, Lb),resolve_value(S, HostType, Ub)} of - {FixV,FixV} -> - {'SizeConstraint',FixV}; - {Low,High} when Low < High -> - {'SizeConstraint',{Low,High}}; - Err -> - throw({error,{asn1,{illegal_size_constraint,Err}}}) - end; -check_constraint(S, HostType, {'SizeConstraint',Lb}) -> - {'SizeConstraint',resolve_value(S, HostType, Lb)}; -check_constraint(S, HostType, {'SingleValue', L}) when is_list(L) -> - F = fun(A) -> resolve_value(S, HostType, A) end, - {'SingleValue',lists:sort(lists:map(F,L))}; -check_constraint(S, HostType, {'SingleValue', V}) -> - {'SingleValue',resolve_value(S, HostType, V)}; -check_constraint(S, HostType, {'ValueRange', {Lb, Ub}}) -> - {'ValueRange',{resolve_value(S, HostType, Lb), - resolve_value(S, HostType, Ub)}}; -%% In case of a constraint with extension marks like (1..Ub,...) -check_constraint(S, HostType, {VR={'ValueRange', {_Lb, _Ub}},Rest}) -> - {check_constraint(S, HostType, VR),Rest}; -check_constraint(_S, _HostType, {'PermittedAlphabet',PA}) -> - {'PermittedAlphabet',permitted_alphabet_cnstr(PA)}; -check_constraint(S, HostType, {valueset,Type}) -> - {valueset,check_type(S, #typedef{typespec=HostType}, Type)}; -check_constraint(_S, _HostType, {simpletable,Type}=ST) when is_atom(Type) -> - %% An already checked constraint - ST; -check_constraint(S, HostType, {simpletable,Type}) -> - Def = case Type of - #type{def=D} -> D; - {'SingleValue',ObjRef = #'Externalvaluereference'{}} -> - ObjRef - end, - C = match_parameter(S, Def), - case C of - #'Externaltypereference'{} -> - ERef = check_externaltypereference(S,C), - {simpletable,ERef#'Externaltypereference'.type}; - {valueset,#type{def=ERef=#'Externaltypereference'{}}} -> % this is an object set - {_,TDef} = get_referenced_type(S,ERef), - case TDef#typedef.typespec of - #'ObjectSet'{} -> - check_object(S,TDef,TDef#typedef.typespec), - {simpletable,ERef#'Externaltypereference'.type}; - Err -> - exit({error,{internal_error,Err}}) - end; - #'Externalvaluereference'{} -> - %% This is an object set with a referenced object - {_,TorVDef} = get_referenced_type(S,C), - GetObjectSet = - fun(#typedef{typespec=O}) when is_record(O,'Object') -> - #'ObjectSet'{class=O#'Object'.classname, - set={'SingleValue',C}}; - (#valuedef{type=Cl,value=O}) - when is_record(O,'Externalvaluereference'), - is_record(Cl,type) -> - %% an object might reference another object - #'ObjectSet'{class=Cl#type.def, - set={'SingleValue',O}}; - (Err) -> - exit({error,{internal_error,simpletable_constraint,Err}}) - end, - ObjSet = GetObjectSet(TorVDef), - {simpletable,check_object(S,Type,ObjSet)}; - #'ObjectSet'{} -> - io:format("ALERT: simpletable forbidden case!~n",[]), - {simpletable,check_object(S,Type,C)}; - {'ValueFromObject',{_,Object},FieldNames} -> - %% This is an ObjectFromObject. - {simpletable,extract_field(S, Object, FieldNames)}; - _ -> - check_type(S, HostType, Type),%% this seems stupid. - OSName = Def#'Externaltypereference'.type, - {simpletable,OSName} - end; -check_constraint(S, _HostType, {componentrelation,{objectset,Opos,Objset},Id}) -> - %% Objset is an 'Externaltypereference' record, since Objset is - %% a DefinedObjectSet. - RealObjset = match_parameter(S, Objset), - ObjSetRef = - case RealObjset of - #'Externaltypereference'{} -> RealObjset; - #type{def=#'Externaltypereference'{}} -> RealObjset#type.def; - {valueset,OS = #type{def=#'Externaltypereference'{}}} -> OS#type.def - end, - Ext = check_externaltypereference(S,ObjSetRef), - {componentrelation,{objectset,Opos,Ext},Id}; -check_constraint(S, HostType, #type{}=Type) -> - #type{def=Def} = check_type(S, HostType, Type), - Def; -check_constraint(S, HostType, C) when is_list(C) -> - [check_constraint(S, HostType, X) || X <- C]; -%% else keep the constraint unchanged -check_constraint(_S, _HostType, Any) -> - Any. - -permitted_alphabet_cnstr(T) when is_tuple(T) -> - permitted_alphabet_cnstr([T]); -permitted_alphabet_cnstr(L) when is_list(L) -> - VRexpand = fun({'ValueRange',{A,B}}) -> - {'SingleValue',expand_valuerange(A,B)}; - (Other) -> - Other - end, - L2 = lists:map(VRexpand,L), - %% first perform intersection - L3 = permitted_alphabet_intersection(L2), - [Res] = permitted_alphabet_union(L3), - Res. - -expand_valuerange([A],[A]) -> - [A]; -expand_valuerange([A],[B]) when A < B -> - [A|expand_valuerange([A+1],[B])]. - -permitted_alphabet_intersection(C) -> - permitted_alphabet_merge(C,intersection, []). - -permitted_alphabet_union(C) -> - permitted_alphabet_merge(C,union, []). - -permitted_alphabet_merge([],_,Acc) -> - lists:reverse(Acc); -permitted_alphabet_merge([{'SingleValue',L1}, - UorI, - {'SingleValue',L2}|Rest],UorI,Acc) - when is_list(L1),is_list(L2) -> - UI = ordsets:UorI([ordsets:from_list(L1),ordsets:from_list(L2)]), - permitted_alphabet_merge([{'SingleValue',UI}|Rest],UorI,Acc); -permitted_alphabet_merge([C1|Rest],UorI,Acc) -> - permitted_alphabet_merge(Rest,UorI,[C1|Acc]). - - -%% constraint_merge/2 -%% Compute the intersection of the outermost level of the constraint list. -%% See Dubuisson second paragraph and fotnote on page 285. -%% If constraints with extension are included in combined constraints. The -%% resulting combination will have the extension of the last constraint. Thus, -%% there will be no extension if the last constraint is without extension. -%% The rootset of all constraints are considered in the "outermoust -%% intersection". See section 13.1.2 in Dubuisson. -constraint_merge(St, Cs0) -> - Cs = constraint_merge_1(St, Cs0), - normalize_cs(Cs). - -normalize_cs([{'SingleValue',[V]}|Cs]) -> - [{'SingleValue',V}|normalize_cs(Cs)]; -normalize_cs([{'SingleValue',[_|_]=L0}|Cs]) -> - [H|T] = L = lists:usort(L0), - [case is_range(H, T) of - false -> {'SingleValue',L}; - true -> {'ValueRange',{H,lists:last(T)}} - end|normalize_cs(Cs)]; -normalize_cs([{'ValueRange',{Sv,Sv}}|Cs]) -> - [{'SingleValue',Sv}|normalize_cs(Cs)]; -normalize_cs([{'ValueRange',{'MIN','MAX'}}|Cs]) -> - normalize_cs(Cs); -normalize_cs([{'SizeConstraint',C0}|Cs]) -> - case normalize_size_constraint(C0) of - none -> - normalize_cs(Cs); - C -> - [{'SizeConstraint',C}|normalize_cs(Cs)] - end; -normalize_cs([H|T]) -> - [H|normalize_cs(T)]; -normalize_cs([]) -> []. - -%% Normalize a size constraint to make it non-ambiguous and -%% easy to interpret for the backends. -%% -%% Returns one of the following terms: -%% {LowerBound,UpperBound} -%% {{LowerBound,UpperBound},[]} % Extensible -%% none % Remove size constraint from list -%% -%% where: -%% LowerBound = integer() -%% UpperBound = integer() | 'MAX' - -normalize_size_constraint(Sv) when is_integer(Sv) -> - {Sv,Sv}; -normalize_size_constraint({Root,Ext}) when is_list(Ext) -> - {normalize_size_constraint(Root),[]}; -normalize_size_constraint({{_,_},Ext}) when is_integer(Ext) -> - normalize_size_constraint(Ext); -normalize_size_constraint([H|T]) -> - {H,lists:last(T)}; -normalize_size_constraint({0,'MAX'}) -> - none; -normalize_size_constraint({Lb,Ub}=Range) - when is_integer(Lb), is_integer(Ub) orelse Ub =:= 'MAX' -> - Range. - -is_range(Prev, [H|T]) when Prev =:= H - 1 -> is_range(H, T); -is_range(_, [_|_]) -> false; -is_range(_, []) -> true. - -constraint_merge_1(_S, [H]=C) when is_tuple(H) -> - C; -constraint_merge_1(_S, []) -> - []; -constraint_merge_1(S, C) -> - %% skip all extension but the last extension - C1 = filter_extensions(C), - %% perform all internal level intersections, intersections first - %% since they have precedence over unions - C2 = lists:map(fun(X)when is_list(X)->constraint_intersection(S,X); - (X) -> X end, - C1), - %% perform all internal level unions - C3 = lists:map(fun(X)when is_list(X)->constraint_union(S,X); - (X) -> X end, - C2), - - %% now get intersection of the outermost level - %% get the least common single value constraint - SVs = get_constraints(C3,'SingleValue'), - CombSV = intersection_of_sv(S,SVs), - %% get the least common value range constraint - VRs = get_constraints(C3,'ValueRange'), - CombVR = intersection_of_vr(S,VRs), - %% get the least common size constraint - SZs = get_constraints(C3,'SizeConstraint'), - CombSZ = intersection_of_size(S,SZs), - RestC = ordsets:subtract(ordsets:from_list(C3), - ordsets:from_list(SZs ++ VRs ++ SVs)), - %% get the least common combined constraint. That is the union of each - %% deep constraint and merge of single value and value range constraints. - %% FIXME: Removing 'intersection' from the flattened list essentially - %% means that intersections are converted to unions! - Cs = combine_constraints(S, CombSV, CombVR, CombSZ++RestC), - [X || X <- lists:flatten(Cs), - X =/= intersection, - X =/= union]. - -%% constraint_union(S,C) takes a list of constraints as input and -%% merge them to a union. Unions are performed when two -%% constraints is found with an atom union between. -%% The list may be nested. Fix that later !!! -constraint_union(_S,[]) -> - []; -constraint_union(_S,C=[_E]) -> - C; -constraint_union(S,C) when is_list(C) -> - case lists:member(union,C) of - true -> - constraint_union1(S,C,[]); - _ -> - C - end; -% SV = get_constraints(C,'SingleValue'), -% SV1 = constraint_union_sv(S,SV), -% VR = get_constraints(C,'ValueRange'), -% VR1 = constraint_union_vr(VR), -% RestC = ordsets:filter(fun({'SingleValue',_})->false; -% ({'ValueRange',_})->false; -% (_) -> true end,ordsets:from_list(C)), -% SV1++VR1++RestC; -constraint_union(_S,C) -> - [C]. - -constraint_union1(S, [{'ValueRange',{Lb1,Ub1}},union, - {'ValueRange',{Lb2,Ub2}}|Rest], Acc) -> - AunionB = {'ValueRange',{c_min(Lb1, Lb2),max(Ub1, Ub2)}}, - constraint_union1(S, [AunionB|Rest], Acc); -constraint_union1(S,[A={'SingleValue',_},union,B={'SingleValue',_}|Rest],Acc) -> - AunionB = constraint_union_sv(S,[A,B]), - constraint_union1(S,Rest,Acc ++ AunionB); -constraint_union1(S,[A={'SingleValue',_},union,B={'ValueRange',_}|Rest],Acc) -> - AunionB = union_sv_vr(S,A,B), - constraint_union1(S, AunionB++Rest, Acc); -constraint_union1(S,[A={'ValueRange',_},union,B={'SingleValue',_}|Rest],Acc) -> - AunionB = union_sv_vr(S,B,A), - constraint_union1(S, AunionB++Rest, Acc); -constraint_union1(S,[union|Rest],Acc) -> %skip when unsupported constraints - constraint_union1(S,Rest,Acc); -constraint_union1(S,[A|Rest],Acc) -> - constraint_union1(S,Rest,[A|Acc]); -constraint_union1(_S,[],Acc) -> - Acc. - -constraint_union_sv(_S,SV) -> - Values=lists:map(fun({_,V})->V end,SV), - case ordsets:from_list(Values) of - [] -> []; - [N] -> [{'SingleValue',N}]; - L -> [{'SingleValue',L}] - end. -c_min('MIN', _) -> 'MIN'; -c_min(_, 'MIN') -> 'MIN'; -c_min(A, B) -> min(A, B). - -union_sv_vr(_S,{'SingleValue',SV},VR) - when is_integer(SV) -> - union_sv_vr(_S,{'SingleValue',[SV]},VR); -union_sv_vr(_S,{'SingleValue',SV},{'ValueRange',{VLb,VUb}}) - when is_list(SV) -> - L = lists:sort(SV++[VLb,VUb]), - {Lb,L1} = case lists:member('MIN',L) of - true -> {'MIN',L--['MIN']}; % remove 'MIN' so it does not disturb - false -> {hd(L),tl(L)} - end, - Ub = case lists:member('MAX',L1) of - true -> 'MAX'; - false -> lists:last(L1) - end, - case SV of - [H] -> H; - _ -> SV - end, - %% for now we through away the Singlevalues so that they don't disturb - %% in the code generating phase (the effective Valuerange is already - %% calculated. If we want to keep the Singlevalues as well for - %% use in code gen phases we need to introduce a new representation - %% like {'ValueRange',{Lb,Ub},[ListOfRanges|AntiValues|Singlevalues] - %% These could be used to generate guards which allows only the specific - %% values , not the full range - [{'ValueRange',{Lb,Ub}}]. - - -%% get_constraints/2 -%% Arguments are a list of constraints, which has the format {key,value}, -%% and a constraint type -%% Returns a list of constraints only of the requested type or the atom -%% 'no' if no such constraints were found -get_constraints(L=[{CType,_}],CType) -> - L; -get_constraints(C,CType) -> - keysearch_allwithkey(CType,1,C). - -%% keysearch_allwithkey(Key,Ix,L) -%% Types: -%% Key = is_atom() -%% Ix = integer() -%% L = [TwoTuple] -%% TwoTuple = [{atom(),term()}|...] -%% Returns a List that contains all -%% elements from L that has a key Key as element Ix -keysearch_allwithkey(Key,Ix,L) -> - lists:filter(fun(X) when is_tuple(X) -> - case element(Ix,X) of - Key -> true; - _ -> false - end; - (_) -> false - end, L). - - -%% filter_extensions(C) -%% takes a list of constraints as input and returns a list with the -%% constraints and all extensions but the last are removed. -filter_extensions([L]) when is_list(L) -> - [filter_extensions(L)]; -filter_extensions(C=[_H]) -> - C; -filter_extensions(C) when is_list(C) -> - filter_extensions(C,[], []). - -filter_extensions([],Acc,[]) -> - Acc; -filter_extensions([],Acc,[EC|ExtAcc]) -> - CwoExt = remove_extension(ExtAcc,[]), - CwoExt ++ [EC|Acc]; -filter_extensions([C={A,_E}|T],Acc,ExtAcc) when is_tuple(A) -> - filter_extensions(T,Acc,[C|ExtAcc]); -filter_extensions([C={'SizeConstraint',{A,_B}}|T],Acc,ExtAcc) - when is_list(A);is_tuple(A) -> - filter_extensions(T,Acc,[C|ExtAcc]); -filter_extensions([C={'PermittedAlphabet',{{'SingleValue',_},E}}|T],Acc,ExtAcc) - when is_tuple(E); is_list(E) -> - filter_extensions(T,Acc,[C|ExtAcc]); -filter_extensions([H|T],Acc,ExtAcc) -> - filter_extensions(T,[H|Acc],ExtAcc). - -remove_extension([],Acc) -> - Acc; -remove_extension([{'SizeConstraint',{A,_B}}|R],Acc) -> - remove_extension(R,[{'SizeConstraint',A}|Acc]); -remove_extension([{C,_E}|R],Acc) when is_tuple(C) -> - remove_extension(R,[C|Acc]); -remove_extension([{'PermittedAlphabet',{A={'SingleValue',_}, - E}}|R],Acc) - when is_tuple(E);is_list(E) -> - remove_extension(R,[{'PermittedAlphabet',A}|Acc]). - -%% constraint_intersection(S,C) takes a list of constraints as input and -%% performs intersections. Intersecions are performed when an -%% atom intersection is found between two constraints. -%% The list may be nested. Fix that later !!! -constraint_intersection(_S,[]) -> - []; -constraint_intersection(_S,C=[_E]) -> - C; -constraint_intersection(S,C) when is_list(C) -> -% io:format("constraint_intersection: ~p~n",[C]), - case lists:member(intersection,C) of - true -> - constraint_intersection1(S,C,[]); - _ -> - C - end; -constraint_intersection(_S,C) -> - [C]. - -constraint_intersection1(S,[A,intersection,B|Rest],Acc) -> - AisecB = c_intersect(S,A,B), - constraint_intersection1(S, AisecB++Rest, Acc); -constraint_intersection1(S,[A|Rest],Acc) -> - constraint_intersection1(S,Rest,[A|Acc]); -constraint_intersection1(_, [], [C]) -> - C; -constraint_intersection1(_,[],Acc) -> - lists:reverse(Acc). - -c_intersect(S,C1={'SingleValue',_},C2={'SingleValue',_}) -> - intersection_of_sv(S,[C1,C2]); -c_intersect(S,C1={'ValueRange',_},C2={'ValueRange',_}) -> - intersection_of_vr(S,[C1,C2]); -c_intersect(S,C1={'ValueRange',_},C2={'SingleValue',_}) -> - intersection_sv_vr(S,[C2],[C1]); -c_intersect(S,C1={'SingleValue',_},C2={'ValueRange',_}) -> - intersection_sv_vr(S,[C1],[C2]); -c_intersect(_S,C1,C2) -> - [C1,C2]. - -%% combine_constraints(S,SV,VR,CComb) -%% Types: -%% S = is_record(state,S) -%% SV = [] | [SVC] -%% VR = [] | [VRC] -%% CComb = [] | [Lists] -%% SVC = {'SingleValue',integer()} | {'SingleValue',[integer(),...]} -%% VRC = {'ValueRange',{Lb,Ub}} -%% Lists = List of lists containing any constraint combination -%% Lb = 'MIN' | integer() -%% Ub = 'MAX' | integer() -%% Returns a combination of the least common constraint among SV,VR and all -%% elements in CComb -combine_constraints(_S,[],VR,CComb) -> - VR ++ CComb; -% combine_combined_cnstr(S,VR,CComb); -combine_constraints(_S,SV,[],CComb) -> - SV ++ CComb; -% combine_combined_cnstr(S,SV,CComb); -combine_constraints(S,SV,VR,CComb) -> - C=intersection_sv_vr(S,SV,VR), - C ++ CComb. -% combine_combined_cnstr(S,C,CComb). - -intersection_sv_vr(_S,[C1={'SingleValue',SV}],[C2={'ValueRange',{_Lb,_Ub}}]) - when is_integer(SV) -> - case is_int_in_vr(SV,C2) of - true -> [C1]; - _ -> %%error({type,{"asn1 illegal constraint",C1,C2},S}) - %throw({error,{"asn1 illegal constraint",C1,C2}}) - %io:format("warning: could not analyze constraint ~p~n",[[C1,C2]]), - [C1,C2] - end; -intersection_sv_vr(_S,[C1={'SingleValue',SV}],[C2]) - when is_list(SV) -> - case lists:filter(fun(X)->is_int_in_vr(X,C2) end,SV) of - [] -> - %%error({type,{"asn1 illegal constraint",C1,C2},S}); - %throw({error,{"asn1 illegal constraint",C1,C2}}); - %io:format("warning: could not analyze constraint ~p~n",[[C1,C2]]), - [C1,C2]; - [V] -> [{'SingleValue',V}]; - L -> [{'SingleValue',L}] - end. - - -%% Size constraint [{'SizeConstraint',1},{'SizeConstraint',{{1,64},[]}}] -intersection_of_size(_,[]) -> - []; -intersection_of_size(_,C=[_SZ]) -> - C; -intersection_of_size(S,[SZ,SZ|Rest]) -> - intersection_of_size(S,[SZ|Rest]); -intersection_of_size(S,C=[C1={_,Int},{_,Range}|Rest]) - when is_integer(Int),is_tuple(Range) -> - case Range of - {Lb,Ub} when Int >= Lb, - Int =< Ub -> - intersection_of_size(S,[C1|Rest]); - {{Lb,Ub},Ext} when is_list(Ext),Int >= Lb,Int =< Ub -> - intersection_of_size(S,[C1|Rest]); - _ -> - throw({error,{asn1,{illegal_size_constraint,C}}}) - end; -intersection_of_size(S,[C1={_,Range},C2={_,Int}|Rest]) - when is_integer(Int),is_tuple(Range) -> - intersection_of_size(S,[C2,C1|Rest]); -intersection_of_size(S,[{_,{Lb1,Ub1}},{_,{Lb2,Ub2}}|Rest]) -> - Lb=greatest_LB(ordsets:from_list([Lb1,Lb2])), - Ub=smallest_UB(ordsets:from_list([Ub1,Ub2])), - intersection_of_size(S,[{'SizeConstraint',{Lb,Ub}}|Rest]); -intersection_of_size(_,SZ) -> - throw({error,{asn1,{illegal_size_constraint,SZ}}}). - -intersection_of_vr(_,[]) -> - []; -intersection_of_vr(_,VR=[_C]) -> - VR; -intersection_of_vr(S,[{_,{Lb1,Ub1}},{_,{Lb2,Ub2}}|Rest]) -> - Lb=greatest_LB(ordsets:from_list([Lb1,Lb2])), - Ub=smallest_UB(ordsets:from_list([Ub1,Ub2])), - intersection_of_vr(S,[{'ValueRange',{Lb,Ub}}|Rest]); -intersection_of_vr(_S,VR) -> - %%error({type,{asn1,{illegal_value_range_constraint,VR}},S}); - throw({error,{asn1,{illegal_value_range_constraint,VR}}}). - -intersection_of_sv(_,[]) -> - []; -intersection_of_sv(_,SV=[_C]) -> - SV; -intersection_of_sv(S,[SV,SV|Rest]) -> - intersection_of_sv(S,[SV|Rest]); -intersection_of_sv(S,[{_,Int},{_,SV}|Rest]) when is_integer(Int), - is_list(SV) -> - SV2=intersection_of_sv1(S,Int,SV), - intersection_of_sv(S,[SV2|Rest]); -intersection_of_sv(S,[{_,SV},{_,Int}|Rest]) when is_integer(Int), - is_list(SV) -> - SV2=intersection_of_sv1(S,Int,SV), - intersection_of_sv(S,[SV2|Rest]); -intersection_of_sv(S,[{_,SV1},{_,SV2}|Rest]) when is_list(SV1), - is_list(SV2) -> - SV3=common_set(SV1,SV2), - intersection_of_sv(S,[SV3|Rest]); -intersection_of_sv(_S,SV) -> - %%error({type,{asn1,{illegal_single_value_constraint,SV}},S}). - throw({error,{asn1,{illegal_single_value_constraint,SV}}}). - -intersection_of_sv1(_S,Int,SV) when is_integer(Int),is_list(SV) -> - case lists:member(Int,SV) of - true -> {'SingleValue',Int}; - _ -> - %%error({type,{asn1,{illegal_single_value_constraint,Int,SV}},S}) - throw({error,{asn1,{illegal_single_value_constraint,Int,SV}}}) - end; -intersection_of_sv1(_S,SV1,SV2) -> - %%error({type,{asn1,{illegal_single_value_constraint,SV1,SV2}},S}). - throw({error,{asn1,{illegal_single_value_constraint,SV1,SV2}}}). - -greatest_LB([H]) -> - H; -greatest_LB(L) -> - greatest_LB1(lists:reverse(L)). -greatest_LB1(['MIN',H2|_T])-> - H2; -greatest_LB1([H|_T]) -> - H. -smallest_UB(L) -> - hd(L). - -common_set(SV1,SV2) -> - lists:filter(fun(X)->lists:member(X,SV1) end,SV2). - -is_int_in_vr(Int,{_,{'MIN','MAX'}}) when is_integer(Int) -> - true; -is_int_in_vr(Int,{_,{'MIN',Ub}}) when is_integer(Int),Int =< Ub -> - true; -is_int_in_vr(Int,{_,{Lb,'MAX'}}) when is_integer(Int),Int >= Lb -> - true; -is_int_in_vr(Int,{_,{Lb,Ub}}) when is_integer(Int),Int >= Lb,Int =< Ub -> - true; -is_int_in_vr(_,_) -> - false. - +%%% +%%% End of constraint handling. +%%% check_imported(S,Imodule,Name) -> check_imported(S,Imodule,Name,false). @@ -4311,6 +4130,8 @@ match_parameter(#state{parameters=Ps}=S, Name) -> match_parameter(_S, Name, []) -> Name; +match_parameter(S, {valueset,{element_set,#type{}=Ts,none}}, Ps) -> + match_parameter(S, {valueset,Ts}, Ps); match_parameter(_S, #'Externaltypereference'{type=Name}, [{#'Externaltypereference'{type=Name},NewName}|_T]) -> NewName; @@ -4523,13 +4344,11 @@ iof_associated_type1(S,C) -> %% returns the leading attribute, the constraint of the components and %% the tablecinf value for the second component. -instance_of_constraints(S, Constr) -> - case lists:keyfind(simpletable, 1, Constr) of - false -> - {false,[],[],[]}; - {simpletable,Type} -> - instance_of_constraints_1(S, Type) - end. +instance_of_constraints(_, []) -> + {false,[],[],[]}; +instance_of_constraints(S, [{element_set,{simpletable,C},none}]) -> + {element_set,Type,none} = C, + instance_of_constraints_1(S, Type). instance_of_constraints_1(S, Type) -> #type{def=#'Externaltypereference'{type=Name}} = Type, @@ -6064,49 +5883,6 @@ merge_tags2([H|T],Acc) -> merge_tags2([], Acc) -> lists:reverse(Acc). -%% merge_constraints(C1, []) -> -%% C1; -%% merge_constraints([], C2) -> -%% C2; -%% merge_constraints(C1, C2) -> -%% {SList,VList,PAList,Rest} = splitlist(C1++C2,[],[],[],[]), -%% SizeC = merge_constraints(SList), -%% ValueC = merge_constraints(VList), -%% PermAlphaC = merge_constraints(PAList), -%% case Rest of -%% [] -> -%% SizeC ++ ValueC ++ PermAlphaC; -%% _ -> -%% throw({error,{asn1,{not_implemented,{merge_constraints,Rest}}}}) -%% end. - -%% merge_constraints([]) -> []; -%% merge_constraints([C1 = {_,{Low1,High1}},{_,{Low2,High2}}|Rest]) when Low1 >= Low2, -%% High1 =< High2 -> -%% merge_constraints([C1|Rest]); -%% merge_constraints([C1={'PermittedAlphabet',_},C2|Rest]) -> -%% [C1|merge_constraints([C2|Rest])]; -%% merge_constraints([C1 = {_,{_Low1,_High1}},C2 = {_,{_Low2,_High2}}|_Rest]) -> -%% throw({error,asn1,{conflicting_constraints,{C1,C2}}}); -%% merge_constraints([C]) -> -%% [C]. - -%% splitlist([C={'SizeConstraint',_}|Rest],Sacc,Vacc,PAacc,Restacc) -> -%% splitlist(Rest,[C|Sacc],Vacc,PAacc,Restacc); -%% splitlist([C={'ValueRange',_}|Rest],Sacc,Vacc,PAacc,Restacc) -> -%% splitlist(Rest,Sacc,[C|Vacc],PAacc,Restacc); -%% splitlist([C={'PermittedAlphabet',_}|Rest],Sacc,Vacc,PAacc,Restacc) -> -%% splitlist(Rest,Sacc,Vacc,[C|PAacc],Restacc); -%% splitlist([C|Rest],Sacc,Vacc,PAacc,Restacc) -> -%% splitlist(Rest,Sacc,Vacc,PAacc,[C|Restacc]); -%% splitlist([],Sacc,Vacc,PAacc,Restacc) -> -%% {lists:reverse(Sacc), -%% lists:reverse(Vacc), -%% lists:reverse(PAacc), -%% lists:reverse(Restacc)}. - - - storeindb(S,M) when is_record(M,module) -> TVlist = M#module.typeorval, NewM = M#module{typeorval=findtypes_and_values(TVlist)}, @@ -6208,12 +5984,16 @@ format_error(illegal_octet_string_value) -> "expecting a bstring or an hstring as value for an OCTET STRING"; format_error({illegal_typereference,Name}) -> io_lib:format("'~p' is used as a typereference, but does not start with an uppercase letter", [Name]); +format_error(illegal_table_constraint) -> + "table constraints may only be applied to CLASS.&field constructs"; format_error(illegal_value) -> "expected a value"; format_error({invalid_fields,Fields,Obj}) -> io_lib:format("invalid ~s in ~p", [format_fields(Fields),Obj]); format_error({invalid_bit_number,Bit}) -> io_lib:format("the bit number '~p' is invalid", [Bit]); +format_error(invalid_table_constraint) -> + "the table constraint is not an object set"; format_error({missing_mandatory_fields,Fields,Obj}) -> io_lib:format("missing mandatory ~s in ~p", [format_fields(Fields),Obj]); @@ -6224,6 +6004,8 @@ format_error({missing_ocft,Component}) -> io_lib:format("the component '~s' must be an ObjectClassFieldType (CLASSNAME.&field-name)", [Component]); format_error({namelist_redefinition,Name}) -> io_lib:format("the name '~s' can not be redefined", [Name]); +format_error(reversed_range) -> + "ranges must be given in increasing order"; format_error({syntax_duplicated_fields,Fields}) -> io_lib:format("~s must only occur once in the syntax list", [format_fields(Fields)]); diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl index bdd14871d1..4f528b6f95 100644 --- a/lib/asn1/src/asn1ct_imm.erl +++ b/lib/asn1/src/asn1ct_imm.erl @@ -499,6 +499,8 @@ per_dec_enumerated_fix_list([], Tail, _) -> Tail. per_dec_integer_1([{'SingleValue',Value}], _Aligned) -> {value,Value}; +per_dec_integer_1([{'ValueRange',{'MIN',_}}], Aligned) -> + per_dec_unconstrained(Aligned); per_dec_integer_1([{'ValueRange',{Lb,'MAX'}}], Aligned) when is_integer(Lb) -> per_decode_semi_constrained(Lb, Aligned); per_dec_integer_1([{'ValueRange',{Lb,Ub}}], Aligned) when is_integer(Lb), @@ -1094,6 +1096,9 @@ per_enc_integer_1(Val0, [Constr], Aligned) -> per_enc_integer_2(Val, {'SingleValue',Sv}, Aligned) when is_integer(Sv) -> per_enc_constrained(Val, Sv, Sv, Aligned); +per_enc_integer_2(Val, {'ValueRange',{'MIN',Ub}}, Aligned) + when is_integer(Ub) -> + {[],{lt,Val,Ub+1},per_enc_unconstrained(Val, Aligned)}; per_enc_integer_2(Val0, {'ValueRange',{Lb,'MAX'}}, Aligned) when is_integer(Lb) -> {Prefix,Val} = sub_lb(Val0, Lb), diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl index 9b2fc0b046..c19811ea49 100644 --- a/lib/asn1/src/asn1ct_parser2.erl +++ b/lib/asn1/src/asn1ct_parser2.erl @@ -655,7 +655,8 @@ parse_TypeWithConstraint([{'SEQUENCE',_},Lpar = {'(',_}|Rest]) -> parse_TypeWithConstraint([{'SEQUENCE',_},{'SIZE',_},Lpar = {'(',_}|Rest]) -> {Constraint,Rest2} = parse_Constraint([Lpar|Rest]), #constraint{c=C} = Constraint, - Constraint2 = Constraint#constraint{c={'SizeConstraint',C}}, + Constraint2 = Constraint#constraint{c={element_set,{'SizeConstraint',C}, + none}}, Rest4 = case Rest2 of [{'OF',_}, {identifier,_,_Id}|Rest3] -> %%% TODO: make some use of the identifier, maybe useful in the XML mapping @@ -689,7 +690,8 @@ parse_TypeWithConstraint([{'SET',_},Lpar = {'(',_}|Rest]) -> parse_TypeWithConstraint([{'SET',_},{'SIZE',_},Lpar = {'(',_}|Rest]) -> {Constraint,Rest2} = parse_Constraint([Lpar|Rest]), #constraint{c=C} = Constraint, - Constraint2 = Constraint#constraint{c={'SizeConstraint',C}}, + Constraint2 = Constraint#constraint{c={element_set, + {'SizeConstraint',C},none}}, Rest4 = case Rest2 of [{'OF',_}, {identifier,_,_Id}|Rest3] -> %%% TODO: make some use of the identifier, maybe useful in the XML mapping @@ -876,19 +878,16 @@ parse_TypeColonValue(Tokens) -> parse_SubtypeConstraint(Tokens) -> parse_ElementSetSpecs(Tokens). -parse_ElementSetSpecs([{'...',_}|Rest]) -> - {Elements,Rest2} = parse_ElementSetSpec(Rest), - {{[],Elements},Rest2}; parse_ElementSetSpecs(Tokens) -> {RootElems,Rest} = parse_ElementSetSpec(Tokens), case Rest of [{',',_},{'...',_},{',',_}|Rest2] -> {AdditionalElems,Rest3} = parse_ElementSetSpec(Rest2), - {{RootElems,AdditionalElems},Rest3}; + {{element_set,RootElems,AdditionalElems},Rest3}; [{',',_},{'...',_}|Rest2] -> - {{RootElems,[]},Rest2}; + {{element_set,RootElems,empty},Rest2}; _ -> - {RootElems,Rest} + {{element_set,RootElems,none},Rest} end. parse_ElementSetSpec([{'ALL',_},{'EXCEPT',_}|Rest]) -> @@ -909,14 +908,8 @@ parse_Unions(Tokens) -> case {InterSec,Unions} of {InterSec,[]} -> {InterSec,Rest2}; - {{'SingleValue',V1},{'SingleValue',V2}} -> - {{'SingleValue',ordsets:union(to_set(V1),to_set(V2))},Rest2}; - {V1,V2} when is_list(V2) -> - {[V1] ++ [union|V2],Rest2}; {V1,V2} -> - {[V1,union,V2],Rest2} -% Other -> -% throw(Other) + {{union,V1,V2},Rest2} end. parse_UnionsRec([{'|',_}|Rest]) -> @@ -925,12 +918,8 @@ parse_UnionsRec([{'|',_}|Rest]) -> case {InterSec,URec} of {V1,[]} -> {V1,Rest3}; - {{'SingleValue',V1},{'SingleValue',V2}} -> - {{'SingleValue',ordsets:union(to_set(V1),to_set(V2))},Rest3}; - {V1,V2} when is_list(V2) -> - {[V1] ++ [union|V2],Rest3}; {V1,V2} -> - {[V1,union,V2],Rest3} + {{union,V1,V2},Rest3} end; parse_UnionsRec([{'UNION',Info}|Rest]) -> parse_UnionsRec([{'|',Info}|Rest]); @@ -943,13 +932,8 @@ parse_Intersections(Tokens) -> case {InterSec,IRec} of {V1,[]} -> {V1,Rest2}; - {{'SingleValue',V1},{'SingleValue',V2}} -> - {{'SingleValue', - ordsets:intersection(to_set(V1),to_set(V2))},Rest2}; - {V1,V2} when is_list(V2) -> - {[V1] ++ [intersection|V2],Rest2}; {V1,V2} -> - {[V1,intersection,V2],Rest2} + {{intersection,V1,V2},Rest2} end. %% parse_IElemsRec(Tokens) -> Result @@ -958,15 +942,10 @@ parse_IElemsRec([{'^',_}|Rest]) -> {InterSec,Rest2} = parse_IntersectionElements(Rest), {IRec,Rest3} = parse_IElemsRec(Rest2), case {InterSec,IRec} of - {{'SingleValue',V1},{'SingleValue',V2}} -> - {{'SingleValue', - ordsets:intersection(to_set(V1),to_set(V2))},Rest3}; {V1,[]} -> - {V1,Rest3}; - {V1,V2} when is_list(V2) -> - {[V1] ++ [intersection|V2],Rest3}; + {V1,Rest2}; {V1,V2} -> - {[V1,intersection,V2],Rest3} + {{intersection,V1,V2},Rest3} end; parse_IElemsRec([{'INTERSECTION',Info}|Rest]) -> parse_IElemsRec([{'^',Info}|Rest]); @@ -1589,14 +1568,11 @@ parse_ObjectSet(Tokens) -> throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), [got,get_token(hd(Tokens)),expected,'{']}}). -parse_ObjectSetSpec([{'...',_}|Rest]) -> - case Rest of - [{',',_}|Rest2] -> - {Elements,Rest3}=parse_ElementSetSpecs(Rest2), - {{[],Elements},Rest3}; - _ -> - {['EXTENSIONMARK'],Rest} - end; +parse_ObjectSetSpec([{'...',_},{',',_}|Tokens0]) -> + {Elements,Tokens} = parse_ElementSetSpec(Tokens0), + {{element_set,empty,Elements},Tokens}; +parse_ObjectSetSpec([{'...',_}|Tokens]) -> + {{element_set,empty,empty},Tokens}; parse_ObjectSetSpec(Tokens) -> parse_ElementSetSpecs(Tokens). @@ -1885,7 +1861,7 @@ parse_TableConstraint(Tokens) -> parse_SimpleTableConstraint(Tokens) -> {ObjectSet,Rest} = parse_ObjectSet(Tokens), - {{simpletable,ObjectSet},Rest}. + {{element_set,{simpletable,ObjectSet},none},Rest}. parse_ComponentRelationConstraint([{'{',_}|Rest]) -> {ObjectSet,Rest2} = parse_DefinedObjectSet(Rest), @@ -1894,7 +1870,10 @@ parse_ComponentRelationConstraint([{'{',_}|Rest]) -> {AtNot,Rest4} = parse_AtNotationList(Rest3,[]), case Rest4 of [{'}',_}|Rest5] -> - {{componentrelation,ObjectSet,AtNot},Rest5}; + Ret = {element_set, + {componentrelation,ObjectSet,AtNot}, + none}, + {Ret,Rest5}; [H|_T] -> throw({asn1_error,{get_line(H),get(asn1_module), [got,get_token(H),expected,'}']}}) @@ -2333,12 +2312,6 @@ check_rest([]) -> check_rest(_) -> false. - -to_set(V) when is_list(V) -> - ordsets:from_list(V); -to_set(V) -> - ordsets:from_list([V]). - parse_AlternativeTypeLists(Tokens) -> parse_AlternativeTypeLists(Tokens,[]). @@ -3062,95 +3035,20 @@ parse_PresenceConstraint(Tokens) -> {asn1_empty,Tokens}. -% merge_constraints({Rlist,ExtList}) -> % extensionmarker in constraint -% {merge_constraints(Rlist,[],[]), -% merge_constraints(ExtList,[],[])}; - -%% An arg with a constraint with extension marker will look like -%% [#constraint{c={Root,Ext}}|Rest] - merge_constraints(Clist) -> merge_constraints(Clist, [], []). -merge_constraints([Ch|Ct],Cacc, Eacc) -> - NewEacc = case Ch#constraint.e of - undefined -> Eacc; - E -> [E|Eacc] - end, - merge_constraints(Ct,[fixup_constraint(Ch#constraint.c)|Cacc],NewEacc); - -merge_constraints([],Cacc,[]) -> -%% lists:flatten(Cacc); +merge_constraints([#constraint{c=C,e=E}|T], Cacc0, Eacc0) -> + Eacc = case E of + undefined -> Eacc0; + E -> [E|Eacc0] + end, + Cacc = [C|Cacc0], + merge_constraints(T, Cacc, Eacc); +merge_constraints([], Cacc, []) -> lists:reverse(Cacc); -merge_constraints([],Cacc,Eacc) -> -%% lists:flatten(Cacc) ++ [{'Errors',Eacc}]. - lists:reverse(Cacc) ++ [{'Errors',Eacc}]. - - -fixup_constraint(C) -> - case C of - {'SingleValue',SubType} when element(1,SubType) == 'ContainedSubtype' -> - SubType; - {'SingleValue',V} when is_list(V) -> - C; - %% [C,{'ValueRange',{lists:min(V),lists:max(V)}}]; - %% bug, turns wrong when an element in V is a reference to a defined value - {'PermittedAlphabet',{'SingleValue',V}} when is_list(V) -> - %%sort and remove duplicates - V2 = {'SingleValue', - ordsets:from_list(lists:flatten(V))}, - {'PermittedAlphabet',V2}; - {'PermittedAlphabet',{'SingleValue',V}} -> - V2 = {'SingleValue',[V]}, - {'PermittedAlphabet',V2}; - {'SizeConstraint',Sc} -> - {'SizeConstraint',fixup_size_constraint(Sc)}; - - List when is_list(List) -> %% In This case maybe a union or intersection - [fixup_constraint(Xc)||Xc <- List]; - Other -> - Other - end. - -fixup_size_constraint({'ValueRange',{Lb,Ub}}) -> - {Lb,Ub}; -fixup_size_constraint({{'ValueRange',R},[]}) -> - {R,[]}; -fixup_size_constraint({[],{'ValueRange',R}}) -> - {[],R}; -fixup_size_constraint({{'ValueRange',R1},{'ValueRange',R2}}) -> - {R1,R2}; -fixup_size_constraint({'SingleValue',[Sv]}) -> - fixup_size_constraint({'SingleValue',Sv}); -fixup_size_constraint({'SingleValue',L}) when is_list(L) -> - ordsets:from_list(L); -fixup_size_constraint({'SingleValue',L}) -> - {L,L}; -fixup_size_constraint({'SizeConstraint',C}) -> - %% this is a second SIZE - fixup_size_constraint(C); -fixup_size_constraint({C1,C2}) -> - %% this is with extension marks - {turn2vr(fixup_size_constraint(C1)), extension_size(fixup_size_constraint(C2))}; -fixup_size_constraint(CList) when is_list(CList) -> - [fixup_constraint(Xc)||Xc <- CList]. - -turn2vr(L) when is_list(L) -> - L2 =[X||X<-ordsets:from_list(L),is_integer(X)], - case L2 of - [H|_] -> - {H,hd(lists:reverse(L2))}; - _ -> - L - end; -turn2vr(VR) -> - VR. -extension_size({I,I}) -> - [I]; -extension_size({I1,I2}) -> - [I1,I2]; -extension_size(C) -> - C. +merge_constraints([], Cacc, Eacc) -> + lists:reverse(Cacc) ++ [{element_set,{'Errors',Eacc},none}]. get_line({_,Pos,Token}) when is_integer(Pos),is_atom(Token) -> Pos; -- cgit v1.2.3 From 0c2cb3cba7d8adee96453cf2be008a3edca25c8b Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Thu, 20 Nov 2014 12:40:36 +0100 Subject: asn1: Fix import checking code All errors were not reported. Furthermore, get_referenced_type/2 will report errors if any module is missing, so the attempt to report additional errors in chained_import/4 would not find any errors. --- lib/asn1/src/asn1_records.hrl | 2 +- lib/asn1/src/asn1ct_check.erl | 57 +++++++++---------------------------------- 2 files changed, 12 insertions(+), 47 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1_records.hrl b/lib/asn1/src/asn1_records.hrl index 24f4eabe38..a67c2e5cb2 100644 --- a/lib/asn1/src/asn1_records.hrl +++ b/lib/asn1/src/asn1_records.hrl @@ -90,7 +90,7 @@ vname, erule, parameters=[], - inputmodules, + inputmodules=[], abscomppath=[], recordtopname=[], options, diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index d748042df6..5c1113c865 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -268,53 +268,18 @@ check_imports(S, #module{imports={imports,Imports}}) -> check_imports_1(_S, [], Acc) -> Acc; -check_imports_1(S, [#'SymbolsFromModule'{symbols=Imports,module=ModuleRef}|SFMs], Acc0) -> +check_imports_1(S, [#'SymbolsFromModule'{symbols=Imports,module=ModuleRef}|SFMs], Acc) -> Module = name_of_def(ModuleRef), - Refs0 = [{catch get_referenced_type(S, Ref),Ref} || Ref <- Imports], - Refs = [{M,R} || {{M,_},R} <- Refs0], - {Illegal,Other} = lists:splitwith(fun({error,_}) -> true; - (_) -> false - end, Refs), - ChainedRefs = [R || {M,R} <- Other, M =/= Module], - IllegalRefs = [R || {error,R} <- Illegal] ++ - [R || {M,R} <- ChainedRefs, - ok =/= chained_import(S, Module, M, name_of_def(R))], - Acc = [return_asn1_error(S, Ref, {undefined_import,name_of_def(Ref),Module}) || - Ref <- IllegalRefs] ++ Acc0, - check_imports_1(S, SFMs, Acc). - -chained_import(S,ImpMod,DefMod,Name) -> - %% Name is a referenced structure that is not defined in ImpMod, - %% but must be present in the Imports list of ImpMod. The chain of - %% imports of Name must end in DefMod. - GetImports = - fun(_M_) -> - case asn1_db:dbget(_M_,'MODULE') of - #module{imports={imports,ImportList}} -> - ImportList; - _ -> [] - end - end, - FindNameInImports = - fun([],N,_) -> {no_mod,N}; - ([#'SymbolsFromModule'{symbols=Imports,module=ModuleRef}|SFMs],N,F) -> - case [name_of_def(X) || X <- Imports, name_of_def(X) =:= N] of - [] -> F(SFMs,N,F); - [N] -> {name_of_def(ModuleRef),N} - end - end, - case GetImports(ImpMod) of - [] -> - error; - Imps -> - case FindNameInImports(Imps,Name,FindNameInImports) of - {no_mod,_} -> - error; - {DefMod,_} -> ok; - {OtherMod,_} -> - chained_import(S,OtherMod,DefMod,Name) - end - end. + Refs = [{try get_referenced_type(S, Ref) + catch throw:Error -> Error end, + Ref} + || Ref <- Imports], + CreateError = fun(Ref) -> + Error = {undefined_import,name_of_def(Ref),Module}, + return_asn1_error(S, Ref, Error) + end, + Errors = [CreateError(Ref) || {{error, _}, Ref} <- Refs], + check_imports_1(S, SFMs, Errors ++ Acc). checkt(S0, Names) -> Check = fun do_checkt/3, -- cgit v1.2.3 From 411f2d2c42ab86872186c0ea015f2e76a84c30ab Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Thu, 27 Nov 2014 12:50:37 +0100 Subject: asn1: Fix error reporting for the EXTERNAL type Change to new error handling system and cover with tests. --- lib/asn1/src/asn1ct_check.erl | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 5c1113c865..68b1a499e3 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2013,7 +2013,7 @@ to_EXTERNAL1990(S, [{#seqtag{val=identification}=T, to_EXTERNAL1990(S, Rest, [{T#seqtag{val='indirect-reference'},PCid}, {T#seqtag{val='direct-reference'},TrStx}]); to_EXTERNAL1990(S, _) -> - error({value,"illegal value in EXTERNAL type",S}). + asn1_error(S, illegal_external_value). to_EXTERNAL1990(S, [V={#seqtag{val='data-value-descriptor'},_}|Rest], Acc) -> to_EXTERNAL1990(S, Rest, [V|Acc]); @@ -2021,7 +2021,7 @@ to_EXTERNAL1990(_S, [{#seqtag{val='data-value'}=T,Val}], Acc) -> Encoding = {T#seqtag{val=encoding},{'CHOICE',{'octet-aligned',Val}}}, lists:reverse([Encoding|Acc]); to_EXTERNAL1990(S, _, _) -> - error({value,"illegal value in EXTERNAL type",S}). + asn1_error(S, illegal_external_value). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Functions to normalize the default values of SEQUENCE @@ -5933,6 +5933,8 @@ format_error(illegal_bitstring_value) -> "expecting a BIT STRING value"; format_error({illegal_class_name,Class}) -> io_lib:format("the class name '~s' is illegal (it must start with an uppercase letter and only contain uppercase letters, digits, or hyphens)", [Class]); +format_error(illegal_external_value) -> + "illegal value in EXTERNAL type"; format_error({illegal_instance_of,Class}) -> io_lib:format("using INSTANCE OF on class '~s' is illegal, " "because INSTANCE OF may only be used on the class TYPE-IDENTIFIER", -- cgit v1.2.3 From a008779a0d8b602a56c63d333f692f51e0b64994 Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Thu, 27 Nov 2014 13:41:00 +0100 Subject: asn1: Rewrite error handling for EXPORT to new style --- lib/asn1/src/asn1ct_check.erl | 37 +++++++++++-------------------------- 1 file changed, 11 insertions(+), 26 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 68b1a499e3..d76ecee3b9 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -241,26 +241,18 @@ check_exports(S,Module = #module{}) -> {exports,all} -> []; {exports,ExportList} when is_list(ExportList) -> - IsNotDefined = + IsNotDefined = fun(X) -> - case catch get_referenced_type(S,X) of - {error,{asn1,_}} -> - true; - _ -> false + try + _ = get_referenced_type(S,X), + false + catch {error,_} -> + true end end, - case lists:filter(IsNotDefined,ExportList) of - [] -> - []; - NoDefExp -> - GetName = - fun(T = #'Externaltypereference'{type=N})-> - %%{exported,undefined,entity,N} - NewS=S#state{type=T,tname=N}, - error({export,"exported undefined entity",NewS}) - end, - lists:map(GetName,NoDefExp) - end + [return_asn1_error(S, Ext, {undefined_export, Undef}) || + Ext = #'Externaltypereference'{type=Undef} <- ExportList, + IsNotDefined(Ext)] end. check_imports(S, #module{imports={imports,Imports}}) -> @@ -5992,6 +5984,8 @@ format_error({syntax_undefined_field,Field}) -> [Field]); format_error({undefined,Name}) -> io_lib:format("'~s' is referenced, but is not defined", [Name]); +format_error({undefined_export,Ref}) -> + io_lib:format("'~s' is exported but is not defined", [Ref]); format_error({undefined_field,FieldName}) -> io_lib:format("the field '&~s' is undefined", [FieldName]); format_error({undefined_import,Ref,Module}) -> @@ -6011,15 +6005,6 @@ format_fields([H|T]) -> error({_,{structured_error,_,_,_}=SE,_}) -> SE; -error({export,Msg,#state{mname=Mname,type=Ref,tname=Typename}}) -> - Pos = Ref#'Externaltypereference'.pos, - io:format("asn1error:~p:~p:~p~n~p~n",[Pos,Mname,Typename,Msg]), - {error,{export,Pos,Mname,Typename,Msg}}; -% error({type,{Msg1,Msg2},#state{mname=Mname,type=Type,tname=Typename}}) -% when is_record(Type,typedef) -> -% io:format("asn1error:~p:~p:~p ~p~n", -% [Type#typedef.pos,Mname,Typename,Msg1]), -% {error,{type,Type#typedef.pos,Mname,Typename,Msg1,Msg2}}; error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}}) when is_record(Type,type) -> io:format("asn1error:~p:~p~n~p~n", -- cgit v1.2.3 From 2687287372f725dfb99ca6d712b214751c419cc2 Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Thu, 27 Nov 2014 16:52:19 +0100 Subject: Clean up error reporting for duplicate tags Split the test case duplicate_tags/1 into two parts. Do the error checking test in error_SUITE. Keep the SeqOptional2 specification and compile it from the per/1 and ber_other/1 test cases (for coverage). --- lib/asn1/src/asn1ct_check.erl | 159 +++++++++++---------------------- lib/asn1/src/asn1ct_gen_ber_bin_v2.erl | 35 +------- 2 files changed, 53 insertions(+), 141 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index d76ecee3b9..fa70f7b18c 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -4565,7 +4565,7 @@ check_sequenceof(S,Type,Component) when is_record(Component,type) -> check_set(S,Type,Components) -> {TableCInf,NewComponents} = check_sequence(S,Type,Components), - check_distinct_tags(NewComponents,[]), + check_unique_tags(S, collect_components(NewComponents), []), case {lists:member(der,S#state.options),S#state.erule} of {true,_} -> {Sorted,SortedComponents} = sort_components(der,S,NewComponents), @@ -4577,35 +4577,21 @@ check_set(S,Type,Components) -> {false,TableCInf,NewComponents} end. - -%% check that all tags are distinct according to X.680 26.3 -check_distinct_tags({C1,C2,C3},Acc) when is_list(C1),is_list(C2),is_list(C3) -> - check_distinct_tags(C1++C2++C3,Acc); -check_distinct_tags({C1,C2},Acc) when is_list(C1),is_list(C2) -> - check_distinct_tags(C1++C2,Acc); -check_distinct_tags([#'ComponentType'{tags=[T]}|Cs],Acc) -> - check_distinct(T,Acc), - check_distinct_tags(Cs,[T|Acc]); -check_distinct_tags([C=#'ComponentType'{tags=[T|Ts]}|Cs],Acc) -> - check_distinct(T,Acc), - check_distinct_tags([C#'ComponentType'{tags=Ts}|Cs],[T|Acc]); -check_distinct_tags([#'ComponentType'{tags=[]}|_Cs],_Acc) -> - throw({error,"Not distinct tags in SET"}); -check_distinct_tags([],_) -> - ok. -check_distinct(T,Acc) -> - case lists:member(T,Acc) of - true -> - throw({error,"Not distinct tags in SET"}); - _ -> ok - end. +collect_components({C1,C2,C3}) -> + collect_components(C1++C2++C3); +collect_components({C1,C2}) -> + collect_components(C1++C2); +collect_components(Cs) -> + %% Assert that tags are not empty + [] = [EmptyTag || EmptyTag = #'ComponentType'{tags=[]} <- Cs], + Cs. %% sorting in canonical order according to X.680 8.6, X.691 9.2 %% DER: all components shall be sorted in canonical order. %% PER: only root components shall be sorted in canonical order. The %% extension components shall remain in textual order. %% -sort_components(der,S=#state{tname=TypeName},Components) -> +sort_components(der, S, Components) -> {R1,Ext,R2} = extension(textual_order(Components)), CompsList = case Ext of noext -> R1; @@ -4613,88 +4599,34 @@ sort_components(der,S=#state{tname=TypeName},Components) -> end, case {untagged_choice(S,CompsList),Ext} of {false,noext} -> - {true,sort_components1(S,TypeName,CompsList,[],[],[],[])}; + {true,sort_components1(CompsList)}; {false,_} -> - {true,{sort_components1(S,TypeName,CompsList,[],[],[],[]), []}}; + {true,{sort_components1(CompsList),[]}}; {true,noext} -> %% sort in run-time {dynamic,R1}; _ -> {dynamic,{R1, Ext, R2}} end; -sort_components(per,S=#state{tname=TypeName},Components) -> +sort_components(per, S, Components) -> {R1,Ext,R2} = extension(textual_order(Components)), Root = tag_untagged_choice(S,R1++R2), case Ext of noext -> - {true,sort_components1(S,TypeName,Root,[],[],[],[])}; + {true,sort_components1(Root)}; _ -> - {true,{sort_components1(S,TypeName,Root,[],[],[],[]), - Ext}} + {true,{sort_components1(Root),Ext}} end. -sort_components1(S,TypeName,[C=#'ComponentType'{tags=[{'UNIVERSAL',_}|_R]}|Cs], - UnivAcc,ApplAcc,ContAcc,PrivAcc) -> - sort_components1(S,TypeName,Cs,[C|UnivAcc],ApplAcc,ContAcc,PrivAcc); -sort_components1(S,TypeName,[C=#'ComponentType'{tags=[{'APPLICATION',_}|_R]}|Cs], - UnivAcc,ApplAcc,ContAcc,PrivAcc) -> - sort_components1(S,TypeName,Cs,UnivAcc,[C|ApplAcc],ContAcc,PrivAcc); -sort_components1(S,TypeName,[C=#'ComponentType'{tags=[{'CONTEXT',_}|_R]}|Cs], - UnivAcc,ApplAcc,ContAcc,PrivAcc) -> - sort_components1(S,TypeName,Cs,UnivAcc,ApplAcc,[C|ContAcc],PrivAcc); -sort_components1(S,TypeName,[C=#'ComponentType'{tags=[{'PRIVATE',_}|_R]}|Cs], - UnivAcc,ApplAcc,ContAcc,PrivAcc) -> - sort_components1(S,TypeName,Cs,UnivAcc,ApplAcc,ContAcc,[C|PrivAcc]); -sort_components1(S,TypeName,[],UnivAcc,ApplAcc,ContAcc,PrivAcc) -> - I = #'ComponentType'.tags, - ascending_order_check(S,TypeName,sort_universal_type(UnivAcc)) ++ - ascending_order_check(S,TypeName,lists:keysort(I,ApplAcc)) ++ - ascending_order_check(S,TypeName,lists:keysort(I,ContAcc)) ++ - ascending_order_check(S,TypeName,lists:keysort(I,PrivAcc)). - -ascending_order_check(S,TypeName,Components) -> - ascending_order_check1(S,TypeName,Components), - Components. - -ascending_order_check1(S,TypeName, - [C1 = #'ComponentType'{tags=[{_,T}|_]}, - C2 = #'ComponentType'{tags=[{_,T}|_]}|Rest]) -> - asn1ct:warning("Indistinct tag ~p in SET ~p, components ~p and ~p~n", - [T,TypeName,C1#'ComponentType'.name,C2#'ComponentType'.name],S, - "Indistinct tag in SET"), - ascending_order_check1(S,TypeName,[C2|Rest]); -ascending_order_check1(S,TypeName, - [C1 = #'ComponentType'{tags=[{'UNIVERSAL',T1}|_]}, - C2 = #'ComponentType'{tags=[{'UNIVERSAL',T2}|_]}|Rest]) -> - case (decode_type(T1) == decode_type(T2)) of - true -> - asn1ct:warning("Indistinct tags ~p and ~p in" - " SET ~p, components ~p and ~p~n", - [T1,T2,TypeName,C1#'ComponentType'.name, - C2#'ComponentType'.name],S, - "Indistinct tags and in SET"), - ascending_order_check1(S,TypeName,[C2|Rest]); - _ -> - ascending_order_check1(S,TypeName,[C2|Rest]) - end; -ascending_order_check1(S,N,[_|Rest]) -> - ascending_order_check1(S,N,Rest); -ascending_order_check1(_,_,[]) -> - ok. - -sort_universal_type(Components) -> - List = lists:map(fun(C) -> - #'ComponentType'{tags=[{_,T}|_]} = C, - {decode_type(T),C} - end, - Components), - SortedList = lists:keysort(1,List), - lists:map(fun(X)->element(2,X) end,SortedList). - -decode_type(I) when is_integer(I) -> - I; -decode_type(T) -> - asn1ct_gen_ber_bin_v2:decode_type(T). +sort_components1(Cs0) -> + Cs1 = [{tag_key(Tag),C} || #'ComponentType'{tags=[Tag|_]}=C <- Cs0], + Cs = lists:sort(Cs1), + [C || {_,C} <- Cs]. + +tag_key({'UNIVERSAL',Tag}) -> {0,Tag}; +tag_key({'APPLICATION',Tag}) -> {1,Tag}; +tag_key({'CONTEXT',Tag}) -> {2,Tag}; +tag_key({'PRIVATE',Tag}) -> {3,Tag}. untagged_choice(_S,[#'ComponentType'{typespec=#type{tag=[],def={'CHOICE',_}}}|_Rest]) -> true; @@ -4948,25 +4880,30 @@ check_unique_tags(S,C) -> case (S#state.module)#module.tagdefault of 'AUTOMATIC' -> case any_manual_tag(C) of - false -> true; - _ -> collect_and_sort_tags(C,[]) + false -> + true; + true -> + check_unique_tags(S, C, []) end; _ -> - collect_and_sort_tags(C,[]) + check_unique_tags(S, C, []) end. -collect_and_sort_tags([C|Rest],Acc) when is_record(C,'ComponentType') -> - collect_and_sort_tags(Rest,C#'ComponentType'.tags ++ Acc); -collect_and_sort_tags([_|Rest],Acc) -> - collect_and_sort_tags(Rest,Acc); -collect_and_sort_tags([],Acc) -> - {Dupl,_}= lists:mapfoldl(fun(El,El)->{{dup,El},El};(El,_Prev)-> {El,El} end,notag,lists:sort(Acc)), - Dupl2 = [Dup|| {dup,Dup} <- Dupl], - if - length(Dupl2) > 0 -> - throw({error,{asn1,{duplicates_of_the_tags,Dupl2}}}); - true -> - true +check_unique_tags(S, [#'ComponentType'{name=Name,tags=Tags0}|T], Acc) -> + Tags = [{Tag,Name} || Tag <- Tags0], + check_unique_tags(S, T, Tags ++ Acc); +check_unique_tags(S, [_|T], Acc) -> + check_unique_tags(S, T, Acc); +check_unique_tags(S, [], Acc) -> + R0 = sofs:relation(Acc), + R1 = sofs:relation_to_family(R0), + R2 = sofs:to_external(R1), + Dup = [Els || {_,[_,_|_]=Els} <- R2], + case Dup of + [] -> + ok; + [FirstDupl|_] -> + asn1_error(S, {duplicate_tags,FirstDupl}) end. check_unique(L,Pos) -> @@ -5921,6 +5858,9 @@ asn1_error(S, Item, Error) -> format_error({already_defined,Name,PrevLine}) -> io_lib:format("the name ~p has already been defined at line ~p", [Name,PrevLine]); +format_error({duplicate_tags,Elements}) -> + io_lib:format("duplicate tags in the elements: ~s", + [format_elements(Elements)]); format_error(illegal_bitstring_value) -> "expecting a BIT STRING value"; format_error({illegal_class_name,Class}) -> @@ -6003,6 +5943,11 @@ format_fields([H|T]) -> [io_lib:format("fields '&~s'", [H])| [io_lib:format(", '&~s'", [F]) || F <- T]]. +format_elements([H1,H2|T]) -> + [io_lib:format("~p, ", [H1])|format_elements([H2|T])]; +format_elements([H]) -> + io_lib:format("~p", [H]). + error({_,{structured_error,_,_,_}=SE,_}) -> SE; error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}}) diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl index 41f86046f0..4dedd6305c 100644 --- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl @@ -24,7 +24,7 @@ -include("asn1_records.hrl"). --export([decode_class/1, decode_type/1]). +-export([decode_class/1]). -export([gen_encode/2,gen_encode/3,gen_decode/2,gen_decode/3]). -export([gen_encode_prim/4]). -export([gen_dec_prim/3]). @@ -1544,39 +1544,6 @@ decode_class('CONTEXT') -> decode_class('PRIVATE') -> ?PRIVATE. -decode_type('BOOLEAN') -> 1; -decode_type('INTEGER') -> 2; -decode_type('BIT STRING') -> 3; -decode_type('OCTET STRING') -> 4; -decode_type('NULL') -> 5; -decode_type('OBJECT IDENTIFIER') -> 6; -decode_type('ObjectDescriptor') -> 7; -decode_type('EXTERNAL') -> 8; -decode_type('REAL') -> 9; -decode_type('ENUMERATED') -> 10; -decode_type('EMBEDDED_PDV') -> 11; -decode_type('UTF8String') -> 12; -decode_type('RELATIVE-OID') -> 13; -decode_type('SEQUENCE') -> 16; -decode_type('SEQUENCE OF') -> 16; -decode_type('SET') -> 17; -decode_type('SET OF') -> 17; -decode_type('NumericString') -> 18; -decode_type('PrintableString') -> 19; -decode_type('TeletexString') -> 20; -decode_type('T61String') -> 20; -decode_type('VideotexString') -> 21; -decode_type('IA5String') -> 22; -decode_type('UTCTime') -> 23; -decode_type('GeneralizedTime') -> 24; -decode_type('GraphicString') -> 25; -decode_type('VisibleString') -> 26; -decode_type('GeneralString') -> 27; -decode_type('UniversalString') -> 28; -decode_type('BMPString') -> 30; -decode_type('CHOICE') -> 'CHOICE'; % choice gets the tag from the actual alternative -decode_type(Else) -> exit({error,{asn1,{unrecognized_type,Else}}}). - mkfuncname(#'Externaltypereference'{module=Mod,type=EType}, DecOrEnc) -> CurrMod = get(currmod), case CurrMod of -- cgit v1.2.3 From 76075cb862d629a9624ab4db98ff876e261fc796 Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Fri, 28 Nov 2014 10:58:47 +0100 Subject: Clean up get_unique_fieldname/2 get_unique_fieldname/2 would throw an exception that *all* callers would catch and handle. Since all callers catch the exception, it is much easier to return a special return value. Also use the new error reporting style. While we are at it, remove all catches of {asn1,Error} which are no longer thrown. --- lib/asn1/src/asn1ct_check.erl | 82 +++++++++++++++---------------------------- 1 file changed, 28 insertions(+), 54 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index fa70f7b18c..e6e6fa73c1 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -441,8 +441,6 @@ checko(S0,[Name|Os],Acc,ExclO,ExclOS) -> error({type,Reason,NewS}); {'EXIT',Reason} -> error({type,{internal_error,Reason},NewS}); - {asn1,Reason} -> - error({type,Reason,NewS}); O -> NewObj = Object#typedef{checked=true,typespec=O}, asn1_db:dbput(NewS#state.mname,Name,NewObj), @@ -470,8 +468,6 @@ checko(S0,[Name|Os],Acc,ExclO,ExclOS) -> error({type,Reason,NewS}); {'EXIT',Reason} -> error({type,{internal_error,Reason},NewS}); - {asn1,Reason} -> - error({type,Reason,NewS}); PO -> NewPObj = PObject#pobjectdef{def=PO}, asn1_db:dbput(NewS#state.mname,Name,NewPObj), @@ -486,8 +482,6 @@ checko(S0,[Name|Os],Acc,ExclO,ExclOS) -> error({type,Reason,NewS}); {'EXIT',Reason} -> error({type,{internal_error,Reason},NewS}); - {asn1,Reason} -> - error({type,Reason,NewS}); POS -> %%NewPObjSet = PObjSet#pvaluesetdef{valueset=POS}, asn1_db:dbput(NewS#state.mname,Name,POS), @@ -765,12 +759,9 @@ check_object(S,_ObjDef,#'Object'{classname=ClassRef,def=ObjectDef}) -> check_object(S, _, #'ObjectSet'{class=ClassRef0,set=Set0}=ObjSet0) -> {_,ClassDef} = get_referenced_type(S, ClassRef0), ClassRef = check_externaltypereference(S, ClassRef0), - {UniqueFieldName,UniqueInfo} = - case (catch get_unique_fieldname(S,ClassDef)) of - {error,'__undefined_',_} -> - {{unique,undefined},{unique,undefined}}; - {asn1,Msg,_} -> error({class,Msg,S}); - {'EXIT',Msg} -> error({class,{internal_error,Msg},S}); + {UniqueFieldName,UniqueInfo} = + case get_unique_fieldname(S, ClassDef) of + no_unique -> {{unique,undefined},{unique,undefined}}; Other -> {element(1,Other),Other} end, OSI0 = #osi{st=S,classref=ClassRef,uniq=UniqueInfo,ext=false}, @@ -1272,10 +1263,10 @@ gen_incl_set(S,Fields,#typedef{typespec=#type{def=Eref}}) {_,CDef} = get_referenced_type(S,Eref), gen_incl_set(S,Fields,CDef); gen_incl_set(S,Fields,ClassDef) -> - case catch get_unique_fieldname(S,ClassDef) of - Tuple when tuple_size(Tuple) =:= 3 -> + case get_unique_fieldname(S, ClassDef) of + no_unique -> false; - _ -> + {_, _} -> gen_incl_set1(S,Fields, (ClassDef#classdef.typespec)#objectclass.fields) end. @@ -3009,9 +3000,9 @@ maybe_open_type(S, #objectclass{fields=Fs}=ClassSpec, {typefieldreference,_} -> %% Note: The constraints have not been checked yet, %% so we must use a special lookup routine. - case {catch get_unique_fieldname(S,#classdef{typespec=ClassSpec}), + case {get_unique_fieldname(S, #classdef{typespec=ClassSpec}), get_componentrelation(Constr)} of - {Tuple,_} when tuple_size(Tuple) =:= 3 -> + {no_unique,_} -> OCFT#'ObjectClassFieldType'{fieldname=FieldNames, type='ASN1_OPEN_TYPE'}; {_,no} -> @@ -5045,28 +5036,18 @@ componentrelation_leadingattr(S,[C= #'ComponentType'{}|Cs],CompList,Acc,CompAcc) {[],C}; [{ObjSet,Attr,N,ClassDef,_Path,ValueIndex}|_NewRest] -> OS = object_set_mod_name(S,ObjSet), - UniqueFieldName = - case (catch get_unique_fieldname(S,#classdef{typespec=ClassDef})) of - {error,'__undefined_',_} -> - no_unique; - {asn1,Msg,_} -> - error({type,Msg,S}); - {'EXIT',Msg} -> - error({type,{internal_error,Msg},S}); - {Other,_} -> Other - end, -% UsedFieldName = get_used_fieldname(S,Attr,STList), + UniqFN = get_unique_fieldname(S, + #classdef{typespec=ClassDef}), %% Res should be done differently: even though %% a unique field name exists it is not %% certain that the ObjectClassFieldType of %% the simple table constraint picks that %% class field. Res = #simpletableattributes{objectsetname=OS, -%% c_name=asn1ct_gen:un_hyphen_var(Attr), c_name=Attr, c_index=N, - usedclassfield=UniqueFieldName, - uniqueclassfield=UniqueFieldName, + usedclassfield=UniqFN, + uniqueclassfield=UniqFN, valueindex=ValueIndex}, {[Res],C#'ComponentType'{typespec=NewTSpec}} end; @@ -5185,15 +5166,7 @@ simple_table_info(S,#'ObjectClassFieldType'{classname=ClRef, CDef; _ -> #classdef{typespec=ObjectClass} end, - UniqueName = - case (catch get_unique_fieldname(S,ClassDef)) of - {error,'__undefined_',_} -> no_unique; - {asn1,Msg,_} -> - error({type,Msg,S}); - {'EXIT',Msg} -> - error({type,{internal_error,Msg},S}); - {Other,_} -> Other - end, + UniqueName = get_unique_fieldname(S, ClassDef), {lists:reverse(Path),ObjectClassFieldName,UniqueName}. %% any_component_relation searches for all component relation @@ -5557,26 +5530,25 @@ component_index1(S,Name,[],_) -> error({type,{asn1,"component of at-list was not" " found in substructure",Name},S}). -get_unique_fieldname(_S,ClassDef) when is_record(ClassDef,classdef) -> -%% {_,Fields,_} = ClassDef#classdef.typespec, - Fields = (ClassDef#classdef.typespec)#objectclass.fields, - get_unique_fieldname1(Fields,[]); +get_unique_fieldname(S, #classdef{typespec=TS}) -> + Fields = TS#objectclass.fields, + get_unique_fieldname1(S, Fields, []); get_unique_fieldname(S,#typedef{typespec=#type{def=ClassRef}}) -> %% A class definition may be referenced as %% REFED-CLASS ::= DEFINED-CLASS and then REFED-CLASS is a typedef {_M,ClassDef} = get_referenced_type(S,ClassRef), get_unique_fieldname(S,ClassDef). -get_unique_fieldname1([],[]) -> - throw({error,'__undefined_',[]}); -get_unique_fieldname1([],[Name]) -> - Name; -get_unique_fieldname1([],Acc) -> - throw({asn1,'only one UNIQUE field is allowed in CLASS',Acc}); -get_unique_fieldname1([{fixedtypevaluefield,Name,_,'UNIQUE',Opt}|Rest],Acc) -> - get_unique_fieldname1(Rest,[{Name,Opt}|Acc]); -get_unique_fieldname1([_H|T],Acc) -> - get_unique_fieldname1(T,Acc). +get_unique_fieldname1(S, [{fixedtypevaluefield,Name,_,'UNIQUE',Opt}|T], Acc) -> + get_unique_fieldname1(S, T, [{Name,Opt}|Acc]); +get_unique_fieldname1(S, [_|T], Acc) -> + get_unique_fieldname1(S, T, Acc); +get_unique_fieldname1(S, [], Acc) -> + case Acc of + [] -> no_unique; + [Name] -> Name; + [_|_] -> asn1_error(S, multiple_uniqs) + end. get_tableconstraint_info(S,Type,{CheckedTs,EComps,CheckedTs2}) -> {get_tableconstraint_info(S,Type,CheckedTs,[]), @@ -5901,6 +5873,8 @@ format_error({missing_table_constraint,Component}) -> [Component]); format_error({missing_ocft,Component}) -> io_lib:format("the component '~s' must be an ObjectClassFieldType (CLASSNAME.&field-name)", [Component]); +format_error(multiple_uniqs) -> + "implementation limitation: only one UNIQUE field is allowed in CLASS"; format_error({namelist_redefinition,Name}) -> io_lib:format("the name '~s' can not be redefined", [Name]); format_error(reversed_range) -> -- cgit v1.2.3 From 2a343fda2c75f52bbf35b6d5ca9f3c97037c50b5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 28 Nov 2014 14:38:38 +0100 Subject: Modernize error handling for instatiation of parameterized types --- lib/asn1/src/asn1ct_check.erl | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index e6e6fa73c1..e926312226 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -3154,8 +3154,8 @@ match_args(S,FA = [FormArg|Ft], AA = [ActArg|At], Acc) -> end; match_args(_S,[], [], Acc) -> lists:reverse(Acc); -match_args(_,_, _, _) -> - throw({error,{asn1,{wrong_number_of_arguments}}}). +match_args(S, _, _, _) -> + asn1_error(S, param_wrong_number_of_arguments). %%%%%%%%%%%%%%%%% %% categorize_arg(S,FormalArg,ActualArg) -> {FormalArg,CatgorizedActualArg} @@ -5877,6 +5877,8 @@ format_error(multiple_uniqs) -> "implementation limitation: only one UNIQUE field is allowed in CLASS"; format_error({namelist_redefinition,Name}) -> io_lib:format("the name '~s' can not be redefined", [Name]); +format_error(param_wrong_number_of_arguments) -> + "wrong number of arguments"; format_error(reversed_range) -> "ranges must be given in increasing order"; format_error({syntax_duplicated_fields,Fields}) -> -- cgit v1.2.3 From 303fff739a00200a2a2adf3104e80a9e48012563 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 28 Nov 2014 15:47:44 +0100 Subject: Modernize error handling for illicit tags --- lib/asn1/src/asn1ct_check.erl | 26 ++++++++++++++++---------- 1 file changed, 16 insertions(+), 10 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index e926312226..c52d239ecd 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2564,13 +2564,13 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> {_, MaybeChoice} = get_referenced_type(S, Tref, true), case catch((MaybeChoice#typedef.typespec)#type.def) of {'CHOICE',_} -> - maybe_illicit_implicit_tag(choice,Tag); + maybe_illicit_implicit_tag(S, choice, Tag); 'ANY' -> - maybe_illicit_implicit_tag(open_type,Tag); + maybe_illicit_implicit_tag(S, open_type, Tag); 'ANY DEFINED BY' -> - maybe_illicit_implicit_tag(open_type,Tag); + maybe_illicit_implicit_tag(S, open_type, Tag); 'ASN1_OPEN_TYPE' -> - maybe_illicit_implicit_tag(open_type,Tag); + maybe_illicit_implicit_tag(S, open_type, Tag); _ -> Tag end @@ -2647,10 +2647,10 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> tag = merge_tags(Ct,RefType#type.tag)} end; 'ANY' -> - Ct=maybe_illicit_implicit_tag(open_type,Tag), + Ct = maybe_illicit_implicit_tag(S, open_type, Tag), TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct}; {'ANY_DEFINED_BY',_} -> - Ct=maybe_illicit_implicit_tag(open_type,Tag), + Ct = maybe_illicit_implicit_tag(S, open_type, Tag), TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct}; 'INTEGER' -> TempNewDef#newt{tag= @@ -2800,7 +2800,7 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> tag= merge_tags(Tag,?TAG_CONSTRUCTED(?N_SEQUENCE))}; {'CHOICE',Components} -> - Ct = maybe_illicit_implicit_tag(choice,Tag), + Ct = maybe_illicit_implicit_tag(S, choice, Tag), TempNewDef#newt{type={'CHOICE',check_choice(S,Type,Components)},tag=Ct}; Set when is_record(Set,'SET') -> RecordName= @@ -2851,7 +2851,7 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> Ct = case is_open_type(NewTypeDef) of true -> - maybe_illicit_implicit_tag(open_type,MergedTag); + maybe_illicit_implicit_tag(S, open_type, MergedTag); _ -> MergedTag end, @@ -2955,10 +2955,10 @@ get_class_def(_S, #classdef{}=CD) -> get_class_def(_S, _) -> none. -maybe_illicit_implicit_tag(Kind,Tag) -> +maybe_illicit_implicit_tag(S, Kind, Tag) -> case Tag of [#tag{type='IMPLICIT'}|_T] -> - throw({error,{asn1,{implicit_tag_before,Kind}}}); + asn1_error(S, {implicit_tag_before,Kind}); [ChTag = #tag{type={default,_}}|T] -> case Kind of open_type -> @@ -5865,6 +5865,12 @@ format_error({invalid_bit_number,Bit}) -> io_lib:format("the bit number '~p' is invalid", [Bit]); format_error(invalid_table_constraint) -> "the table constraint is not an object set"; +format_error({implicit_tag_before,Kind}) -> + "illegal implicit tag before " ++ + case Kind of + choice -> "'CHOICE'"; + open_type -> "open type" + end; format_error({missing_mandatory_fields,Fields,Obj}) -> io_lib:format("missing mandatory ~s in ~p", [format_fields(Fields),Obj]); -- cgit v1.2.3 From 1c7802251322ea82ab7a7c5098034a88db69e787 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 1 Dec 2014 13:35:04 +0100 Subject: BER: Fix ENUMERATED with negative values The ASN.1 compiler would go into an infinite loop if a value in an ENUMERATED was negative. --- lib/asn1/src/asn1ct_gen_ber_bin_v2.erl | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl index 4dedd6305c..37413298a7 100644 --- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl @@ -278,8 +278,7 @@ emit_enc_enumerated_cases(L, Tags) -> emit_enc_enumerated_cases(L, Tags, noext). emit_enc_enumerated_cases([{EnumName,EnumVal}|T], Tags, Ext) -> - Bytes = encode_pos_integer(EnumVal, []), - Len = length(Bytes), + {Bytes,Len} = encode_integer(EnumVal), emit([{asis,EnumName}," -> ", {call,ber,encode_tags,[Tags,{asis,Bytes},Len]},";",nl]), emit_enc_enumerated_cases(T, Tags, Ext); @@ -288,10 +287,25 @@ emit_enc_enumerated_cases([], _Tags, _Ext) -> emit([{curr,enumval}," -> exit({error,{asn1, {enumerated_not_in_range,",{curr, enumval},"}}})"]), emit([nl,"end"]). -encode_pos_integer(0, [B|_Acc] = L) when B < 128 -> +encode_integer(Val) -> + Bytes = + if + Val >= 0 -> + encode_integer_pos(Val, []); + true -> + encode_integer_neg(Val, []) + end, + {Bytes,length(Bytes)}. + +encode_integer_pos(0, [B|_Acc]=L) when B < 128 -> + L; +encode_integer_pos(N, Acc) -> + encode_integer_pos((N bsr 8), [N band 16#ff| Acc]). + +encode_integer_neg(-1, [B1|_T]=L) when B1 > 127 -> L; -encode_pos_integer(N, Acc) -> - encode_pos_integer(N bsr 8, [N band 255|Acc]). +encode_integer_neg(N, Acc) -> + encode_integer_neg(N bsr 8, [N band 16#ff|Acc]). %%=============================================================================== %%=============================================================================== -- cgit v1.2.3 From 80d35f40a69215cc1a2c883941a7b137a90db725 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 1 Dec 2014 12:31:19 +0100 Subject: Rewrite checking of ENUMERATED Clean up the checking of ENUMERATED and modernize the error reporting. Also eliminate the unused constraints argument for check_enumerated(). --- lib/asn1/src/asn1ct_check.erl | 200 +++++++++++++++++++++++------------------- 1 file changed, 108 insertions(+), 92 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index c52d239ecd..19ecd78069 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2697,7 +2697,7 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> {'ENUMERATED',NamedNumberList} -> TempNewDef#newt{type= {'ENUMERATED', - check_enumerated(S,NamedNumberList,Constr)}, + check_enumerated(S, NamedNumberList)}, tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_ENUMERATED)), constraint=[]}; @@ -3723,19 +3723,19 @@ resolve_value1(S, _HostType, #valuedef{}=VDef) -> resolve_value1(_, _, V) -> V. -resolve_namednumber(S, #type{def=Def}=Type, Name) -> +resolve_namednumber(S, #type{def=Def}, Name) -> case Def of {'ENUMERATED',NameList} -> - resolve_namednumber_1(S, Name, NameList, Type); + resolve_namednumber_1(S, Name, NameList); {'INTEGER',NameList} -> - resolve_namednumber_1(S, Name, NameList, Type); + resolve_namednumber_1(S, Name, NameList); _ -> not_named end. -resolve_namednumber_1(S, Name, NameList, Type) -> +resolve_namednumber_1(S, Name, NameList) -> try - NamedNumberList = check_enumerated(S, NameList, Type#type.constraint), + NamedNumberList = check_enumerated(S, NameList), {_,N} = lookup_enum_value(S, Name, NamedNumberList), N catch _:_ -> @@ -4318,93 +4318,100 @@ instance_of_constraints_1(S, Type) -> valueindex=[]}, {TableCInf,[{simpletable,Name}],CRel,[{objfun,ObjectSetRef}]}. -%% Check ENUMERATED -%% **************************************** -%% Check that all values are unique -%% assign values to un-numbered identifiers -%% check that the constraints are allowed and correct -%% put the updated info back into database -check_enumerated(_S,[{Name,Number}|_Rest]= NNList,_Constr) when is_atom(Name), is_integer(Number)-> - %% already checked , just return the same list - NNList; -check_enumerated(_S,{[{Name,Number}|_Rest],L}= NNList,_Constr) when is_atom(Name), is_integer(Number), is_list(L)-> - %% already checked , contains extension marker, just return the same lists - NNList; -check_enumerated(S,NamedNumberList,_Constr) -> - check_enum(S,NamedNumberList,[],[],[]). - -%% identifiers are put in Acc2 -%% returns either [{Name,Number}] or {[{Name,Number}],[{ExtName,ExtNumber}]} -%% the latter is returned if the ENUMERATION contains EXTENSIONMARK -check_enum(S,[{'NamedNumber',Id,Num}|T],Acc1,Acc2,Root) when is_integer(Num) -> - check_enum(S,T,[{Id,Num}|Acc1],Acc2,Root); -check_enum(S,['EXTENSIONMARK'|T],Acc1,Acc2,_Root) -> - NewAcc2 = lists:keysort(2,Acc1), - NewList = enum_number(lists:reverse(Acc2),NewAcc2,0,[],[]), - { NewList, check_enum(S,T,[],[],enum_counts(NewList))}; -check_enum(S,[Id|T],Acc1,Acc2,Root) when is_atom(Id) -> - check_enum(S,T,Acc1,[Id|Acc2],Root); -check_enum(_S,[],Acc1,Acc2,Root) -> - NewAcc2 = lists:keysort(2,Acc1), - enum_number(lists:reverse(Acc2),NewAcc2,0,[],Root). - - -% assign numbers to identifiers , numbers from 0 ... but must not -% be the same as already assigned to NamedNumbers -enum_number(Identifiers,NamedNumbers,Cnt,Acc,[]) -> - enum_number(Identifiers,NamedNumbers,Cnt,Acc); -enum_number(Identifiers,NamedNumbers,_Cnt,Acc,CountL) -> - enum_extnumber(Identifiers,NamedNumbers,Acc,CountL). - -enum_number([H|T],[{Id,Num}|T2],Cnt,Acc) when Num > Cnt -> - enum_number(T,[{Id,Num}|T2],Cnt+1,[{H,Cnt}|Acc]); -enum_number([H|T],[{Id,Num}|T2],Cnt,Acc) when Num < Cnt -> % negative Num - enum_number(T,T2,Cnt+1,[{H,Cnt},{Id,Num}|Acc]); -enum_number([],L2,_Cnt,Acc) -> - lists:append([lists:reverse(Acc),L2]); -enum_number(L,[{Id,Num}|T2],Cnt,Acc) -> % Num == Cnt - enum_number(L,T2,Cnt+1,[{Id,Num}|Acc]); -enum_number([H|T],[],Cnt,Acc) -> - enum_number(T,[],Cnt+1,[{H,Cnt}|Acc]). - -enum_extnumber(Identifiers,NamedNumbers,Acc,[C]) -> - check_add_enum_numbers(NamedNumbers,[C]), - enum_number(Identifiers,NamedNumbers,C,Acc); -enum_extnumber([H|T],[{Id,Num}|T2],Acc,[C|Counts]) when Num > C -> - enum_extnumber(T,[{Id,Num}|T2],[{H,C}|Acc],Counts); -enum_extnumber([],L2,Acc,Cnt) -> - check_add_enum_numbers(L2, Cnt), - lists:concat([lists:reverse(Acc),L2]); -enum_extnumber(_Identifiers,[{Id,Num}|_T2],_Acc,[C|_]) when Num < C -> -%% enum_extnumber(Identifiers,T2,[{Id,Num}|Acc],Counts); - exit({error,{asn1,"AdditionalEnumeration element with same number as root element",{Id,Num}}}); -enum_extnumber(Identifiers,[{Id,Num}|T2],Acc,[_C|Counts]) -> % Num =:= C - enum_extnumber(Identifiers,T2,[{Id,Num}|Acc],Counts); -enum_extnumber([H|T],[],Acc,[C|Counts]) -> - enum_extnumber(T,[],[{H,C}|Acc],Counts). - -enum_counts([]) -> - [0]; -enum_counts(L) -> - Used=[I||{_,I}<-L], - AddEnumLb = lists:max(Used) + 1, - lists:foldl(fun(El,AccIn)->lists:delete(El,AccIn) end, - lists:seq(0,AddEnumLb), - Used). -check_add_enum_numbers(L, Cnt) -> - Max = lists:max(Cnt), - Fun = fun({_,N}=El) when N < Max -> - case lists:member(N,Cnt) of - false -> - exit({error,{asn1,"AdditionalEnumeration element with same number as root element",El}}); - _ -> - ok - end; - (_) -> - ok - end, - lists:foreach(Fun,L). +%%% +%%% Check ENUMERATED. +%%% + +check_enumerated(_S, [{Name,Number}|_]=NNL) + when is_atom(Name), is_integer(Number) -> + %% Already checked. + NNL; +check_enumerated(_S, {[{Name,Number}|_],L}=NNL) + when is_atom(Name), is_integer(Number), is_list(L) -> + %% Already checked (with extension). + NNL; +check_enumerated(S, NNL) -> + check_enum_ids(S, NNL, gb_sets:empty()), + check_enum(S, NNL, gb_sets:empty(), []). + +check_enum_ids(S, [{'NamedNumber',Id,_}|T], Ids0) -> + Ids = check_enum_update_ids(S, Id, Ids0), + check_enum_ids(S, T, Ids); +check_enum_ids(S, ['EXTENSIONMARK'|T], Ids) -> + check_enum_ids(S, T, Ids); +check_enum_ids(S, [Id|T], Ids0) when is_atom(Id) -> + Ids = check_enum_update_ids(S, Id, Ids0), + check_enum_ids(S, T, Ids); +check_enum_ids(_, [], _) -> + ok. + +check_enum(S, [{'NamedNumber',Id,N}|T], Used0, Acc) -> + Used = check_enum_update_used(S, Id, N, Used0), + check_enum(S, T, Used, [{Id,N}|Acc]); +check_enum(S, ['EXTENSIONMARK'|Ext0], Used0, Acc0) -> + Acc = lists:reverse(Acc0), + {Root,Used,Cnt} = check_enum_number_root(Acc, Used0, 0, []), + Ext = check_enum_ext(S, Ext0, Used, Cnt, []), + {Root,Ext}; +check_enum(S, [Id|T], Used, Acc) when is_atom(Id) -> + check_enum(S, T, Used, [Id|Acc]); +check_enum(_, [], Used, Acc0) -> + Acc = lists:reverse(Acc0), + {Root,_,_} = check_enum_number_root(Acc, Used, 0, []), + lists:keysort(2, Root). + +check_enum_number_root([Id|T]=T0, Used0, Cnt, Acc) when is_atom(Id) -> + case gb_sets:is_element(Cnt, Used0) of + false -> + Used = gb_sets:insert(Cnt, Used0), + check_enum_number_root(T, Used, Cnt+1, [{Id,Cnt}|Acc]); + true -> + check_enum_number_root(T0, Used0, Cnt+1, Acc) + end; +check_enum_number_root([H|T], Used, Cnt, Acc) -> + check_enum_number_root(T, Used, Cnt, [H|Acc]); +check_enum_number_root([], Used, Cnt, Acc) -> + {lists:keysort(2, Acc),Used,Cnt}. + +check_enum_ext(S, [{'NamedNumber',Id,N}|T], Used0, C, Acc) -> + Used = check_enum_update_used(S, Id, N, Used0), + if + N < C -> + asn1_error(S, {enum_not_ascending,Id,N,C-1}); + true -> + ok + end, + check_enum_ext(S, T, Used, N+1, [{Id,N}|Acc]); +check_enum_ext(S, [Id|T]=T0, Used0, C, Acc) when is_atom(Id) -> + case gb_sets:is_element(C, Used0) of + true -> + check_enum_ext(S, T0, Used0, C+1, Acc); + false -> + Used = gb_sets:insert(C, Used0), + check_enum_ext(S, T, Used, C+1, [{Id,C}|Acc]) + end; +check_enum_ext(_, [], _, _, Acc) -> + lists:keysort(2, Acc). + +check_enum_update_ids(S, Id, Ids) -> + case gb_sets:is_element(Id, Ids) of + false -> + gb_sets:insert(Id, Ids); + true -> + asn1_error(S, {enum_illegal_redefinition,Id}) + end. +check_enum_update_used(S, Id, N, Used) -> + case gb_sets:is_element(N, Used) of + false -> + gb_sets:insert(N, Used); + true -> + asn1_error(S, {enum_reused_value,Id,N}) + end. + +%%% +%%% End of ENUMERATED checking. +%%% check_boolean(_S,_Constr) -> ok. @@ -5833,6 +5840,15 @@ format_error({already_defined,Name,PrevLine}) -> format_error({duplicate_tags,Elements}) -> io_lib:format("duplicate tags in the elements: ~s", [format_elements(Elements)]); +format_error({enum_illegal_redefinition,Id}) -> + io_lib:format("'~s' must not be redefined", [Id]); +format_error({enum_not_ascending,Id,N,Prev}) -> + io_lib:format("the values for enumerations which follow '...' must " + "be in ascending order, but '~p(~p)' is less than the " + "previous value '~p'", [Id,N,Prev]); +format_error({enum_reused_value,Id,Val}) -> + io_lib:format("'~s' has the value '~p' which is used more than once", + [Id,Val]); format_error(illegal_bitstring_value) -> "expecting a BIT STRING value"; format_error({illegal_class_name,Class}) -> -- cgit v1.2.3 From e9b758a50a648e4d0a54963a6530a4b3cb3f68ce Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Mon, 1 Dec 2014 13:22:47 +0100 Subject: Modernize error handling for named values --- lib/asn1/src/asn1ct_check.erl | 15 +++------------ 1 file changed, 3 insertions(+), 12 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 19ecd78069..208b4eb180 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -4019,7 +4019,7 @@ update_state(S,ModuleName) -> get_renamed_reference(S,Name,Module) -> case renamed_reference(S,Name,Module) of undefined -> - throw({error,{asn1,{undefined_type,Name}}}); + asn1_error(S, {undefined, Name}); NewTypeName when NewTypeName =/= Name -> get_referenced1(S,Module,NewTypeName,undefined) end. @@ -4179,8 +4179,8 @@ check_named_number_list(S, NNL0) -> asn1_error(S, {namelist_redefinition,H}) end. -resolve_valueref(S, #'Externalvaluereference'{module=Mod,value=Name}) -> - dbget_ex(S, Mod, Name); +resolve_valueref(S, #'Externalvaluereference'{} = T) -> + get_referenced_value(S, T); resolve_valueref(_, Val) when is_integer(Val) -> Val. @@ -5731,15 +5731,6 @@ get_taglist1(_S,[]) -> %% tag_number('CHARACTER STRING') -> 29; %% tag_number('BMPString') -> 30. - -dbget_ex(_S,Module,Key) -> - case asn1_db:dbget(Module,Key) of - undefined -> - - throw({error,{asn1,{undefined,{Module,Key}}}}); % this is catched on toplevel type or value - T -> T - end. - merge_tags(T1, T2) when is_list(T2) -> merge_tags2(T1 ++ T2, []); merge_tags(T1, T2) -> -- cgit v1.2.3 From 83ba2c5e84cee40698489c8e740c96adc07b1d44 Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Mon, 1 Dec 2014 12:35:33 +0100 Subject: Modernize error handling for BOOLEAN --- lib/asn1/src/asn1ct_check.erl | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 208b4eb180..547a5b01f4 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2068,8 +2068,8 @@ normalize_boolean(_,false,_) -> false; normalize_boolean(S,Bool=#'Externalvaluereference'{},CType) -> get_normalized_value(S,Bool,CType,fun normalize_boolean/3,[]); -normalize_boolean(_,Other,_) -> - throw({error,{asn1,{'invalid default value',Other}}}). +normalize_boolean(S, _, _) -> + asn1_error(S, {illegal_value, "BOOLEAN"}). normalize_integer(_S, Int, _) when is_integer(Int) -> Int; @@ -2116,7 +2116,7 @@ normalize_bitstring(S, Value, Type)-> #valuedef{value=Val} -> normalize_bitstring(S, Val, Type); _ -> - asn1_error(S, illegal_bitstring_value) + asn1_error(S, {illegal_value, "BIT STRING"}) end; RecList when is_list(RecList) -> [normalize_bs_item(S, Item, Type) || Item <- RecList]; @@ -2124,18 +2124,18 @@ normalize_bitstring(S, Value, Type)-> %% Already normalized. Bs; _ -> - asn1_error(S, illegal_bitstring_value) + asn1_error(S, {illegal_value, "BIT STRING"}) end. normalize_bs_item(S, #'Externalvaluereference'{value=Name}, Type) -> case lists:keymember(Name, 1, Type) of true -> Name; - false -> asn1_error(S, illegal_bitstring_value) + false -> asn1_error(S, {illegal_value, "BIT STRING"}) end; normalize_bs_item(_, Atom, _) when is_atom(Atom) -> Atom; normalize_bs_item(S, _, _) -> - asn1_error(S, illegal_bitstring_value). + asn1_error(S, {illegal_value, "BIT STRING"}). hstring_to_binary(L) -> byte_align(hstring_to_bitstring(L)). @@ -5840,8 +5840,6 @@ format_error({enum_not_ascending,Id,N,Prev}) -> format_error({enum_reused_value,Id,Val}) -> io_lib:format("'~s' has the value '~p' which is used more than once", [Id,Val]); -format_error(illegal_bitstring_value) -> - "expecting a BIT STRING value"; format_error({illegal_class_name,Class}) -> io_lib:format("the class name '~s' is illegal (it must start with an uppercase letter and only contain uppercase letters, digits, or hyphens)", [Class]); format_error(illegal_external_value) -> @@ -5865,7 +5863,9 @@ format_error({illegal_typereference,Name}) -> format_error(illegal_table_constraint) -> "table constraints may only be applied to CLASS.&field constructs"; format_error(illegal_value) -> - "expected a value"; + "expecting a value"; +format_error({illegal_value, TYPE}) -> + io_lib:format("expecting a ~s value", [TYPE]); format_error({invalid_fields,Fields,Obj}) -> io_lib:format("invalid ~s in ~p", [format_fields(Fields),Obj]); format_error({invalid_bit_number,Bit}) -> -- cgit v1.2.3 From aed8cf4f5ccbc5b98a691dd0db3203a3c3680983 Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Fri, 28 Nov 2014 11:59:15 +0100 Subject: Modernize error handling for CHOICE --- lib/asn1/src/asn1ct_check.erl | 112 +++++++++++++++++++++--------------------- 1 file changed, 56 insertions(+), 56 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 547a5b01f4..6939339a5b 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2217,37 +2217,19 @@ lookup_enum_value(S, Id, NNL) when is_atom(Id) -> asn1_error(S, S#state.value, {undefined,Id}) end. -normalize_choice(S,{'CHOICE',{C,V}},CType,NameList) when is_atom(C) -> - case catch lists:keysearch(C,#'ComponentType'.name,CType) of - {value,#'ComponentType'{typespec=CT,name=Name}} -> - {C,normalize_value(S,CT,{'DEFAULT',V}, - [Name|NameList])}; - Other -> - asn1ct:warning("Wrong format of type/value ~p/~p~n",[Other,V],S, - "Wrong format of type/value"), - {C,V} +normalize_choice(S, {'CHOICE',{C,V}}, CType, NameList) + when is_atom(C) -> + case lists:keyfind(C, #'ComponentType'.name, CType) of + #'ComponentType'{typespec=CT,name=Name} -> + {C,normalize_value(S, CT, {'DEFAULT',V}, [Name|NameList])}; + false -> + asn1_error(S, {illegal_choice_id,C}) end; -normalize_choice(S,{'DEFAULT',ValueList},CType,NameList) when is_list(ValueList) -> - lists:map(fun(X)-> normalize_choice(S,X,CType,NameList) end, ValueList); -normalize_choice(S,Val=#'Externalvaluereference'{},CType,NameList) -> - {M,#valuedef{value=V}}=get_referenced_type(S,Val), - normalize_choice(update_state(S,M),{'CHOICE',V},CType,NameList); -% get_normalized_value(S,Val,CType,fun normalize_choice/4,[NameList]); -normalize_choice(S,CV={Name,_ChoiceVal},CType,NameList) +normalize_choice(S,CV={Name,_ChoiceVal},CType,NameList) when is_atom(Name) -> -% normalize_choice(S,ChoiceVal,CType,NameList). normalize_choice(S,{'CHOICE',CV},CType,NameList); -normalize_choice(_S,V,_CType,_NameList) -> - exit({error,{bad_choice_value,V}}). - -%% normalize_choice(NameList,S,CVal = {'CHOICE',{_,_}},CType,_) -> -%% normalize_choice(S,CVal,CType,NameList); -%% normalize_choice(NameList,S,CVal={'DEFAULT',VL},CType,_) when is_list(VL)-> -%% normalize_choice(S,CVal,CType,NameList); -%% normalize_choice(NameList,S,CV={Name,_CV},CType,_) when is_atom(Name)-> -%% normalize_choice(S,{'CHOICE',CV},CType,NameList); -%% normalize_choice(_,_S,V,_,_) -> -%% V. +normalize_choice(S, V, _CType, _NameList) -> + asn1_error(S, {illegal_choice_id, error_value(V)}). normalize_sequence(S,Value,Components,NameList) when is_tuple(Components) -> @@ -4724,31 +4706,40 @@ check_selectiontype(S,Name,#type{def=Eref}) tname=get_datastr_name(TypeDef)}, check_selectiontype2(NewS,Name,TypeDef); check_selectiontype(S,Name,Type=#type{def={pt,_,_}}) -> - TName = - case S#state.recordtopname of - [] -> - S#state.tname; - N -> N - end, + TName = case S#state.recordtopname of + [] -> S#state.tname; + N -> N + end, TDef = #typedef{name=TName,typespec=Type}, check_selectiontype2(S,Name,TDef); -check_selectiontype(S,Name,Type) -> - Msg = lists:flatten(io_lib:format("SelectionType error: ~w < ~w must be a reference to a CHOICE.",[Name,Type])), - error({type,Msg,S}). +check_selectiontype(S, _Name, Type) -> + asn1_error(S, {illegal_choice_type, error_value(Type)}). check_selectiontype2(S,Name,TypeDef) -> NewS = S#state{recordtopname=get_datastr_name(TypeDef)}, - CheckedType = check_type(NewS,TypeDef,TypeDef#typedef.typespec), - Components = get_choice_components(S,CheckedType#type.def), - case lists:keysearch(Name,#'ComponentType'.name,Components) of - {value,C} -> - %% The selected type will have the tag of the selected type. - _T = C#'ComponentType'.typespec; -% T#type{tag=def_to_tag(NewS,T#type.def)}; - _ -> - Msg = lists:flatten(io_lib:format("error checking SelectionType: ~w~n",[Name])), - error({type,Msg,S}) + Components = + try + CheckedType = check_type(NewS,TypeDef,TypeDef#typedef.typespec), + get_choice_components(S,CheckedType#type.def) + catch error:_ -> + asn1_error(S, {illegal_choice_type, error_value(TypeDef)}) + end, + case lists:keyfind(Name, #'ComponentType'.name, Components) of + #'ComponentType'{typespec=TS} -> TS; + false -> asn1_error(S, {illegal_choice_id, error_value(Name)}) end. + + +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) -> + C1++C2; +get_choice_components(S,ERef=#'Externaltypereference'{}) -> + {_RefMod,TypeDef}=get_referenced_type(S,ERef), + #typedef{typespec=TS} = TypeDef, + get_choice_components(S,TS#type.def). + + check_restrictedstring(_S,_Def,_Constr) -> ok. @@ -5318,15 +5309,6 @@ tuple2complist({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) -> - C1++C2; -get_choice_components(S,ERef=#'Externaltypereference'{}) -> - {_RefMod,TypeDef}=get_referenced_type(S,ERef), - #typedef{typespec=TS} = TypeDef, - get_choice_components(S,TS#type.def). - extract_at_notation([{Level,ValueRefs}]) -> {Level,[Name || #'Externalvaluereference'{value=Name} <- ValueRefs]}. @@ -5840,6 +5822,10 @@ format_error({enum_not_ascending,Id,N,Prev}) -> format_error({enum_reused_value,Id,Val}) -> io_lib:format("'~s' has the value '~p' which is used more than once", [Id,Val]); +format_error({illegal_choice_id, Id}) -> + io_lib:format("illegal CHOICE identifier: ~p", [Id]); +format_error({illegal_choice_type, Ref}) -> + io_lib:format("expecting a CHOICE type: ~p", [Ref]); format_error({illegal_class_name,Class}) -> io_lib:format("the class name '~s' is illegal (it must start with an uppercase letter and only contain uppercase letters, digits, or hyphens)", [Class]); format_error(illegal_external_value) -> @@ -6236,5 +6222,19 @@ check_fold(S0, [H|T], Check) -> end; check_fold(_, [], Check) when is_function(Check, 3) -> []. +error_value(Value) when is_integer(Value) -> Value; +error_value(Value) when is_atom(Value) -> Value; +error_value(#type{def=Value}) when is_atom(Value) -> Value; +error_value(#type{def=Value}) -> error_value(Value); +error_value(RefOrType) -> + try name_of_def(RefOrType) of + Name -> Name + catch _:_ -> + case get_datastr_name(RefOrType) of + undefined -> RefOrType; + Name -> Name + end + end. + name_of_def(#'Externaltypereference'{type=N}) -> N; name_of_def(#'Externalvaluereference'{value=N}) -> N. -- cgit v1.2.3 From 8f88edbfde720eb42038413527c029e83b27143f Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Wed, 3 Dec 2014 11:31:24 +0100 Subject: Modernize error handling for SEQUENCE While we are at it, also remove an unreachable (too many extensions) error case. --- lib/asn1/src/asn1ct_check.erl | 86 ++++++++++++++++++++++++++----------------- 1 file changed, 53 insertions(+), 33 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 6939339a5b..25deec2c6e 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2223,13 +2223,13 @@ normalize_choice(S, {'CHOICE',{C,V}}, CType, NameList) #'ComponentType'{typespec=CT,name=Name} -> {C,normalize_value(S, CT, {'DEFAULT',V}, [Name|NameList])}; false -> - asn1_error(S, {illegal_choice_id,C}) + asn1_error(S, {illegal_id,C}) end; normalize_choice(S,CV={Name,_ChoiceVal},CType,NameList) when is_atom(Name) -> normalize_choice(S,{'CHOICE',CV},CType,NameList); normalize_choice(S, V, _CType, _NameList) -> - asn1_error(S, {illegal_choice_id, error_value(V)}). + asn1_error(S, {illegal_id, error_value(V)}). normalize_sequence(S,Value,Components,NameList) when is_tuple(Components) -> @@ -2284,12 +2284,9 @@ normalized_record(SorS,S,Value,Components,NameList) -> Value; _ -> NoComps = length(Components), - case normalize_seq_or_set(SorS,S,Value,Components,NameList,[]) of - ListOfVals when length(ListOfVals) == NoComps -> - list_to_tuple([NewName|ListOfVals]); - _ -> - error({type,{illegal,default,value,Value},S}) - end + ListOfVals = normalize_seq_or_set(SorS,S,Value,Components,NameList,[]), + NoComps = length(ListOfVals), %% Assert + list_to_tuple([NewName|ListOfVals]) end. is_record_normalized(S,Name,V = #'Externalvaluereference'{},NumComps) -> case get_referenced_type(S,V) of @@ -2302,10 +2299,11 @@ is_record_normalized(_S,Name,Value,NumComps) when is_tuple(Value) -> is_record_normalized(_,_,_,_) -> false. -normalize_seq_or_set(SorS, S, [{#seqtag{val=Cname},V}|Vs], +normalize_seq_or_set(SorS, S, + [{#seqtag{val=Cname},V}|Vs], [#'ComponentType'{name=Cname,typespec=TS}|Cs], NameList, Acc) -> - NewNameList = + NewNameList = case TS#type.def of #'Externaltypereference'{type=TName} -> [TName]; @@ -2313,24 +2311,26 @@ normalize_seq_or_set(SorS, S, [{#seqtag{val=Cname},V}|Vs], end, NVal = normalize_value(S,TS,{'DEFAULT',V},NewNameList), normalize_seq_or_set(SorS,S,Vs,Cs,NameList,[NVal|Acc]); -normalize_seq_or_set(SorS,S,Values=[{_Cname1,_V}|_Vs], +normalize_seq_or_set(SorS, S, + Values=[{#seqtag{val=Cname0},_V}|_Vs], [#'ComponentType'{prop='OPTIONAL'}|Cs], - NameList,Acc) -> + NameList, Acc) -> + verify_valid_component(S, Cname0, Cs), normalize_seq_or_set(SorS,S,Values,Cs,NameList,[asn1_NOVALUE|Acc]); -normalize_seq_or_set(SorS,S,Values=[{_Cname1,_V}|_Vs], - [#'ComponentType'{name=Cname2,typespec=TS, - prop={'DEFAULT',Value}}|Cs], - NameList,Acc) -> - NewNameList = +normalize_seq_or_set(SorS, S, + Values=[{#seqtag{val=Cname0},_V}|_Vs], + [#'ComponentType'{name=Cname,typespec=TS, + prop={'DEFAULT',Value}}|Cs], + NameList, Acc) -> + verify_valid_component(S, Cname0, Cs), + NewNameList = case TS#type.def of #'Externaltypereference'{type=TName} -> [TName]; - _ -> [Cname2|NameList] + _ -> [Cname|NameList] end, NVal = normalize_value(S,TS,{'DEFAULT',Value},NewNameList), normalize_seq_or_set(SorS,S,Values,Cs,NameList,[NVal|Acc]); -normalize_seq_or_set(_SorS,_S,[],[],_,Acc) -> - lists:reverse(Acc); %% If default value is {} ComponentTypes in SEQUENCE are marked DEFAULT %% or OPTIONAL (or the type is defined SEQUENCE{}, which is handled by %% the previous case). @@ -2353,9 +2353,23 @@ normalize_seq_or_set(SorS,S,Value=#'Externalvaluereference'{}, Cs,NameList,Acc) -> get_normalized_value(S,Value,Cs,fun normalize_seq_or_set/6, [SorS,NameList,Acc]); -normalize_seq_or_set(_SorS,S,V,_,_,_) -> - error({type,{illegal,default,value,V},S}). - +normalize_seq_or_set(_SorS, _S, [], [], _, Acc) -> + lists:reverse(Acc); +normalize_seq_or_set(_SorS, S, V, Cs, _, _) -> + case V of + [{#seqtag{val=Name},_}|_] -> + asn1_error(S, {illegal_id,error_value(Name)}); + [] -> + [#'ComponentType'{name=Name}|_] = Cs, + asn1_error(S, {missing_id,error_value(Name)}) + end. + +verify_valid_component(S, Name, Cs) -> + case lists:keyfind(Name, #'ComponentType'.name, Cs) of + false -> asn1_error(S, {illegal_id,error_value(Name)}); + #'ComponentType'{} -> ok + end. + normalize_seqof(S,Value,Type,NameList) -> normalize_s_of('SEQUENCE OF',S,Value,Type,NameList). @@ -4438,7 +4452,7 @@ check_sequence(S,Type,Comps) -> CompListTuple = complist_as_tuple(NewComps4), {CRelInf,CompListTuple}; Dupl -> - throw({error,{asn1,{duplicate_components,Dupl}}}) + asn1_error(S, {duplicate_identifier, error_value(hd(Dupl))}) end. complist_as_tuple(CompList) -> @@ -4448,8 +4462,6 @@ complist_as_tuple([#'EXTENSIONMARK'{}|T], Acc, Ext, Acc2, root) -> complist_as_tuple(T, Acc, Ext, Acc2, ext); complist_as_tuple([#'EXTENSIONMARK'{}|T], Acc, Ext, Acc2, ext) -> complist_as_tuple(T, Acc, Ext, Acc2, root2); -complist_as_tuple([#'EXTENSIONMARK'{}|_T], _Acc, _Ext, _Acc2, root2) -> - throw({error,{asn1,{too_many_extension_marks}}}); complist_as_tuple([C|T], Acc, Ext, Acc2, root) -> complist_as_tuple(T, [C|Acc], Ext, Acc2, root); complist_as_tuple([C|T], Acc, Ext, Acc2, ext) -> @@ -4495,8 +4507,8 @@ expand_components2(S,{_,OCFT = #'ObjectClassFieldType'{}}) -> expand_components2(S, {undefined,ocft_def(Type)}); expand_components2(S,{_,ERef}) when is_record(ERef,'Externaltypereference') -> expand_components2(S,get_referenced_type(S,ERef)); -expand_components2(_S,Err) -> - throw({error,{asn1,{illegal_COMPONENTS_OF,Err}}}). +expand_components2(S,{_, What}) -> + asn1_error(S, {illegal_COMPONENTS_OF, error_value(What)}). take_only_rootset([])-> []; @@ -4726,7 +4738,7 @@ check_selectiontype2(S,Name,TypeDef) -> end, case lists:keyfind(Name, #'ComponentType'.name, Components) of #'ComponentType'{typespec=TS} -> TS; - false -> asn1_error(S, {illegal_choice_id, error_value(Name)}) + false -> asn1_error(S, {illegal_id, error_value(Name)}) end. @@ -4772,7 +4784,7 @@ check_choice(S,Type,Components) when is_list(Components) -> check_unique_tags(S, NewComps3), complist_as_tuple(NewComps3); Dupl -> - throw({error,{asn1,{duplicate_choice_alternatives,Dupl}}}) + asn1_error(S, {duplicate_identifier,error_value(hd(Dupl))}) end; check_choice(_S,_,[]) -> []. @@ -5631,7 +5643,7 @@ get_OCFType(S,Fields,[PrimFieldName|Rest]) -> {value,Other} -> {element(1,Other),PrimFieldName}; _ -> - throw({error,lists:flatten(io_lib:format("undefined FieldName in ObjectClassFieldType: ~w",[PrimFieldName]))}) + asn1_error(S, {illegal_object_field, PrimFieldName}) end. get_taglist(S,Ext) when is_record(Ext,'Externaltypereference') -> @@ -5810,6 +5822,8 @@ asn1_error(S, Item, Error) -> format_error({already_defined,Name,PrevLine}) -> io_lib:format("the name ~p has already been defined at line ~p", [Name,PrevLine]); +format_error({duplicate_identifier,Ids}) -> + io_lib:format("the identifier '~p' has already been used", [Ids]); format_error({duplicate_tags,Elements}) -> io_lib:format("duplicate tags in the elements: ~s", [format_elements(Elements)]); @@ -5822,12 +5836,14 @@ format_error({enum_not_ascending,Id,N,Prev}) -> format_error({enum_reused_value,Id,Val}) -> io_lib:format("'~s' has the value '~p' which is used more than once", [Id,Val]); -format_error({illegal_choice_id, Id}) -> - io_lib:format("illegal CHOICE identifier: ~p", [Id]); +format_error({illegal_id, Id}) -> + io_lib:format("illegal identifier: ~p", [Id]); format_error({illegal_choice_type, Ref}) -> io_lib:format("expecting a CHOICE type: ~p", [Ref]); format_error({illegal_class_name,Class}) -> io_lib:format("the class name '~s' is illegal (it must start with an uppercase letter and only contain uppercase letters, digits, or hyphens)", [Class]); +format_error({illegal_COMPONENTS_OF, Ref}) -> + io_lib:format("expected a SEQUENCE or SET got: ~p", [Ref]); format_error(illegal_external_value) -> "illegal value in EXTERNAL type"; format_error({illegal_instance_of,Class}) -> @@ -5838,6 +5854,8 @@ format_error(illegal_integer_value) -> "expecting an integer value"; format_error(illegal_object) -> "expecting an object"; +format_error({illegal_object_field, Id}) -> + io_lib:format("expecting a class field: ~p",[Id]); format_error({illegal_oid,o_id}) -> "illegal OBJECT IDENTIFIER"; format_error({illegal_oid,rel_oid}) -> @@ -5870,6 +5888,8 @@ format_error({missing_mandatory_fields,Fields,Obj}) -> format_error({missing_table_constraint,Component}) -> io_lib:format("the component '~s' is referenced by a component relation constraint using the '@field-name' notation, but does not have a table constraint", [Component]); +format_error({missing_id,Id}) -> + io_lib:format("expected the mandatory component '~p'", [Id]); format_error({missing_ocft,Component}) -> io_lib:format("the component '~s' must be an ObjectClassFieldType (CLASSNAME.&field-name)", [Component]); format_error(multiple_uniqs) -> -- cgit v1.2.3 From 2616db481ed47e09a73a1195ed12bcaa9fda9796 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 1 Dec 2014 16:42:29 +0100 Subject: Remove unnecessary internal errors --- lib/asn1/src/asn1ct_check.erl | 34 +++++++++++----------------------- 1 file changed, 11 insertions(+), 23 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 25deec2c6e..cfd31474da 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -616,18 +616,14 @@ check_class_fields(S,[F|Fields],Acc) -> objectset_or_fixedtypevalueset_field -> {_,Name,Type,OSpec} = F, RefType = - case (catch check_type(S,#typedef{typespec=Type},Type)) of - {asn1_class,_ClassDef} -> + try check_type(S,#typedef{typespec=Type},Type) of + #type{} = CheckedType -> + CheckedType + catch {asn1_class,_ClassDef} -> case if_current_checked_type(S,Type) of - true -> - Type#type.def; - _ -> - check_class(S,Type) - end; - CheckedType when is_record(CheckedType,type) -> - CheckedType; - _ -> - error({class,"internal error, check_class_fields",S}) + true -> Type#type.def; + _ -> check_class(S,Type) + end end, if is_record(RefType,'Externaltypereference') -> @@ -2873,9 +2869,7 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> TempNewDef#newt{tag=merge_tags(Tag,CheckedT#type.tag), type=CheckedT#type.def}; 'ASN1_OPEN_TYPE' -> - TempNewDef; - Other -> - exit({'cant check' ,Other}) + TempNewDef end, #newt{type=TDef,tag=NewTags,constraint=NewConstr,inlined=Inlined} = NewDef, Ts#type{def=TDef, @@ -2884,9 +2878,7 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> tag=lists:map(fun(#tag{type={default,TTx}}=TempTag) -> TempTag#tag{type=TTx}; (Other) -> Other - end, NewTags)}; -check_type(_S,Type,Ts) -> - exit({error,{asn1,internal_error,Type,Ts}}). + end, NewTags)}. %% @@ -4004,14 +3996,10 @@ update_state(S,ModuleName) -> S; _ -> parse_and_save(S,ModuleName), - case asn1_db:dbget(ModuleName,'MODULE') of - RefedMod when is_record(RefedMod,module) -> - S#state{mname=ModuleName,module=RefedMod}; - _ -> throw({error,{asn1,{module_does_not_exist,ModuleName}}}) - end + Mod = #module{} = asn1_db:dbget(ModuleName,'MODULE'), + S#state{mname=ModuleName,module=Mod} end. - get_renamed_reference(S,Name,Module) -> case renamed_reference(S,Name,Module) of undefined -> -- cgit v1.2.3 From 7e5865248225e0934bef6c60e474018f28075cea Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Tue, 2 Dec 2014 15:32:49 +0100 Subject: Remove code duplication --- lib/asn1/src/asn1ct_check.erl | 19 ++----------------- 1 file changed, 2 insertions(+), 17 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index cfd31474da..4ff8a414fb 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -3058,23 +3058,8 @@ instantiate_ptype(S,Ptypedef,ParaList) -> %% NewS = S#state{type=NewType,parameters=MatchedArgs,abscomppath=[]}, check_type(NewS, Ptypedef#ptypedef{typespec=NewType}, NewType). -get_datastr_name(#typedef{name=N}) -> - N; -get_datastr_name(#classdef{name=N}) -> - N; -get_datastr_name(#valuedef{name=N}) -> - N; -get_datastr_name(#ptypedef{name=N}) -> - N; -get_datastr_name(#pvaluedef{name=N}) -> - N; -get_datastr_name(#pvaluesetdef{name=N}) -> - N; -get_datastr_name(#pobjectdef{name=N}) -> - N; -get_datastr_name(#pobjectsetdef{name=N}) -> - N. - +get_datastr_name(Type) -> + asn1ct:get_name_of_def(Type). get_pt_args(#ptypedef{args=Args}) -> Args; -- cgit v1.2.3 From 7d390a1ec41268978fbd9ad3727392ad569e8d24 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 2 Dec 2014 15:59:09 +0100 Subject: Makefile: Add missing dependency for asn1ct_gen_check asn1ct_gen_check.erl was added in 7df687d6. --- lib/asn1/src/Makefile | 1 + 1 file changed, 1 insertion(+) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/Makefile b/lib/asn1/src/Makefile index 6798da0072..40f440423d 100644 --- a/lib/asn1/src/Makefile +++ b/lib/asn1/src/Makefile @@ -206,6 +206,7 @@ $(EBIN)/asn1ct_constructed_per.beam: asn1ct_constructed_per.erl asn1_records.hrl $(EBIN)/asn1ct_func.beam: asn1ct_func.erl $(EBIN)/asn1ct_gen.beam: asn1ct_gen.erl asn1_records.hrl $(EBIN)/asn1ct_gen_ber_bin_v2.beam: asn1ct_gen_ber_bin_v2.erl asn1_records.hrl +$(EBIN)/asn1ct_gen_check.beam: asn1_records.hrl $(EBIN)/asn1ct_gen_per.beam: asn1ct_gen_per.erl asn1_records.hrl $(EBIN)/asn1ct_gen_per_rt2ct.beam: asn1ct_gen_per_rt2ct.erl asn1_records.hrl $(EBIN)/asn1ct_imm.beam: asn1ct_imm.erl -- cgit v1.2.3 From 831b45783976886675f853bca8a9a75ec39cda5c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 5 Dec 2014 12:07:10 +0100 Subject: Move checking of UNIQUE & DEFAULT error to asn1ct_check To keep the error reporting code in asn1ct_parser2 simple, we only want to handle pure syntactic errors. Therefore, move the check that UNIQUE and DEFAULT are not applied to the same field to asn1ct_check. --- lib/asn1/src/asn1ct_check.erl | 9 +++++++++ lib/asn1/src/asn1ct_parser2.erl | 10 ++-------- 2 files changed, 11 insertions(+), 8 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 4ff8a414fb..7ed7da2ae7 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -585,6 +585,12 @@ check_class_fields(S,[F|Fields],Acc) -> case element(1,F) of fixedtypevaluefield -> {_,Name,Type,Unique,OSpec} = F, + case {Unique,OSpec} of + {'UNIQUE',{'DEFAULT',_}} -> + asn1_error(S, {unique_and_default,Name}); + {_,_} -> + ok + end, RefType = check_type(S,#typedef{typespec=Type},Type), {fixedtypevaluefield,Name,RefType,Unique,OSpec}; object_or_fixedtypevalue_field -> @@ -5898,6 +5904,9 @@ format_error({undefined_field,FieldName}) -> io_lib:format("the field '&~s' is undefined", [FieldName]); format_error({undefined_import,Ref,Module}) -> io_lib:format("'~s' is not exported from ~s", [Ref,Module]); +format_error({unique_and_default,Field}) -> + io_lib:format("the field '&~s' must not have both 'UNIQUE' and 'DEFAULT'", + [Field]); format_error({value_reused,Val}) -> io_lib:format("the value '~p' is used more than once", [Val]); format_error({non_unique_object,Id}) -> diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl index c19811ea49..3960498742 100644 --- a/lib/asn1/src/asn1ct_parser2.erl +++ b/lib/asn1/src/asn1ct_parser2.erl @@ -1111,14 +1111,8 @@ parse_FixedTypeValueFieldSpec([{valuefieldreference,L1,VFieldName}|Rest]) -> {OptionalitySpec,Rest5} = parse_ValueOptionalitySpec(Rest3), case {Unique,Rest5} of {'UNIQUE',[{Del,_}|_]} when Del =:= ','; Del =:= '}' -> - case OptionalitySpec of - {'DEFAULT',_} -> - throw({asn1_error, - {L1,get(asn1_module), - ['UNIQUE and DEFAULT in same field',VFieldName]}}); - _ -> - {{fixedtypevaluefield,VFieldName,Type,Unique,OptionalitySpec},Rest5} - end; + {{fixedtypevaluefield,VFieldName,Type,Unique, + OptionalitySpec},Rest5}; {_,[{Del,_}|_]} when Del =:= ','; Del =:= '}' -> {{object_or_fixedtypevalue_field,VFieldName,Type,Unique,OptionalitySpec},Rest5}; _ -> -- cgit v1.2.3 From 657fe1cdf9f0e630a3a66ddcad24f143df6e1880 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 2 Dec 2014 17:18:44 +0100 Subject: asn1ct_parser2: Remove unsuccessful parsing of ValueSetFromObjects The TypeFromObject and ValueSetFromObjects grammar productions cannot be distinguished by the parser without the help of type information (which the parser does not have). Since the parser attempts to parse TypeFromObject before ValueSetFromObjects, the parsing of ValueSetFromObjects will always fail. --- lib/asn1/src/asn1ct_parser2.erl | 23 +---------------------- 1 file changed, 1 insertion(+), 22 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl index 3960498742..4a576ce2d2 100644 --- a/lib/asn1/src/asn1ct_parser2.erl +++ b/lib/asn1/src/asn1ct_parser2.erl @@ -719,8 +719,7 @@ parse_TypeWithConstraint(Tokens) -> parse_ReferencedType(Tokens) -> Flist = [fun parse_DefinedType/1, fun parse_SelectionType/1, - fun parse_TypeFromObject/1, - fun parse_ValueSetFromObjects/1], + fun parse_TypeFromObject/1], case (catch parse_or(Tokens,Flist)) of {'EXIT',Reason} -> exit(Reason); @@ -1694,26 +1693,6 @@ parse_ValueFromObject(Tokens) -> %%% throw({asn1_error,{got,Other,expected,'.'}}) end. -parse_ValueSetFromObjects(Tokens) -> - {Objects,Rest} = parse_ReferencedObjects(Tokens), - case Rest of - [{'.',_}|Rest2] -> - {Name,Rest3} = parse_FieldName(Rest2), - case lists:last(Name) of - {typefieldreference,_FieldName} -> - {{'ValueSetFromObjects',Objects,Name},Rest3}; - _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected, - typefieldreference]}}) - end; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'.']}}) -%%% Other -> -%%% throw({asn1_error,{got,Other,expected,'.'}}) - end. - parse_TypeFromObject(Tokens) -> {Objects,Rest} = parse_ReferencedObjects(Tokens), case Rest of -- cgit v1.2.3 From ff8b523c9ad18d52c9ff53882bba0056f2ceb679 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 2 Dec 2014 17:11:22 +0100 Subject: asn1ct_parser2: Simplify parse_Type/1 The parse_Type/1 calls various type parse functions. Most of those functions return a #type record, but not all of them. If a #type{} record is not returned, parse_Type/1 will wrap the return value in a We can simplify the code in parse_Type/1 if we make sure that the type parsing functions called by parse_Type/1 always return a #type{} record. --- lib/asn1/src/asn1ct_parser2.erl | 34 ++++++++++++---------------------- 1 file changed, 12 insertions(+), 22 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl index 4a576ce2d2..d368e149e3 100644 --- a/lib/asn1/src/asn1ct_parser2.erl +++ b/lib/asn1/src/asn1ct_parser2.erl @@ -393,22 +393,13 @@ parse_Type(Tokens) -> Result -> Result end, - case hd(Rest5) of - {'(',_} -> + case Rest5 of + [{'(',_}|_] -> {Constraints,Rest6} = parse_Constraints(Rest5), - if is_record(Type,type) -> - {Type#type{constraint=merge_constraints(Constraints), - tag=Tag2},Rest6}; - true -> - {#type{def=Type,constraint=merge_constraints(Constraints), - tag=Tag2},Rest6} - end; - _ -> - if is_record(Type,type) -> - {Type#type{tag=Tag2},Rest5}; - true -> - {#type{def=Type,tag=Tag2},Rest5} - end + {Type#type{tag=Tag2, + constraint=merge_constraints(Constraints)},Rest6}; + [_|_] -> + {Type#type{tag=Tag2},Rest5} end. parse_BuiltinType([{'BIT',_},{'STRING',_}|Rest]) -> @@ -423,7 +414,7 @@ parse_BuiltinType([{'BIT',_},{'STRING',_}|Rest]) -> [got,get_token(hd(Rest3)),expected,'}']}}) end; _ -> - {{'BIT STRING',[]},Rest} + {#type{def={'BIT STRING',[]}},Rest} end; parse_BuiltinType([{'BOOLEAN',_}|Rest]) -> {#type{def='BOOLEAN'},Rest}; @@ -558,7 +549,7 @@ parse_BuiltinType([{'SEQUENCE',_},{'{',_}|Rest]) -> parse_BuiltinType([{'SEQUENCE',_},{'OF',_},Id={identifier,_,_},Lt={'<',_}|Rest]) -> %% TODO: take care of the identifier for something useful {Type,Rest2} = parse_SelectionType([Id,Lt|Rest]), - {#type{def={'SEQUENCE OF',#type{def=Type,tag=[]}}},Rest2}; + {#type{def={'SEQUENCE OF',Type}},Rest2}; parse_BuiltinType([{'SEQUENCE',_},{'OF',_},{identifier,_,_} |Rest]) -> %% TODO: take care of the identifier for something useful @@ -604,8 +595,7 @@ parse_BuiltinType([{'SET',_},{'{',_}|Rest]) -> parse_BuiltinType([{'SET',_},{'OF',_},Id={identifier,_,_},Lt={'<',_}|Rest]) -> %% TODO: take care of the identifier for something useful {Type,Rest2} = parse_SelectionType([Id,Lt|Rest]), - {#type{def={'SET OF',#type{def=Type,tag=[]}}},Rest2}; - + {#type{def={'SET OF',Type}},Rest2}; parse_BuiltinType([{'SET',_},{'OF',_},{identifier,_,_}|Rest]) -> %%TODO: take care of the identifier for something useful @@ -763,7 +753,7 @@ parse_DefinedType(Tokens) -> parse_SelectionType([{identifier,_,Name},{'<',_}|Rest]) -> {Type,Rest2} = parse_Type(Rest), - {{'SelectionType',Name,Type},Rest2}; + {#type{def={'SelectionType',Name,Type}},Rest2}; parse_SelectionType(Tokens) -> throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), [got,get_token(hd(Tokens)),expected,'identifier <']}}). @@ -1700,7 +1690,7 @@ parse_TypeFromObject(Tokens) -> {Name,Rest3} = parse_FieldName(Rest2), case lists:last(Name) of {typefieldreference,_FieldName} -> - {{'TypeFromObject',Objects,Name},Rest3}; + {#type{def={'TypeFromObject',Objects,Name}},Rest3}; _ -> throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), [got,get_token(hd(Rest2)),expected, @@ -2169,7 +2159,7 @@ parse_SimpleDefinedValue(Tokens) -> parse_ParameterizedType(Tokens) -> {Type,Rest} = parse_SimpleDefinedType(Tokens), {Params,Rest2} = parse_ActualParameterList(Rest), - {{pt,Type,Params},Rest2}. + {#type{def={pt,Type,Params}},Rest2}. parse_ParameterizedValue(Tokens) -> {Value,Rest} = parse_SimpleDefinedValue(Tokens), -- cgit v1.2.3 From a19d71091ac0753e4cfd212b5f2686b53fdf355a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 3 Dec 2014 10:49:13 +0100 Subject: asn1ct_parser2: Throw an {asn1_error,...} for *all* parse errors In a future commit, we want to tighten what we catch. Therefore, legitimate parsing errors should always throw a controlled exception, instead of arbitrarily crashing. --- lib/asn1/src/asn1ct_parser2.erl | 29 ++++++++++++++++++++++++----- 1 file changed, 24 insertions(+), 5 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl index d368e149e3..f3a56e1b65 100644 --- a/lib/asn1/src/asn1ct_parser2.erl +++ b/lib/asn1/src/asn1ct_parser2.erl @@ -1392,7 +1392,10 @@ parse_FieldSetting(Tokens) -> {{PrimFieldName,Setting},Rest2}. parse_DefinedSyntax([{'{',_}|Rest]) -> - parse_DefinedSyntax(Rest,[]). + parse_DefinedSyntax(Rest, []); +parse_DefinedSyntax([H|_]) -> + throw({asn1_error,{get_line(H),get(asn1_module), + [got,get_token(H),expected,['{']]}}). parse_DefinedSyntax(Tokens,Acc) -> case Tokens of @@ -2498,7 +2501,11 @@ parse_ComponentTypeLists([{',',L1},{'...',_},{'!',_}|Rest02],Clist0) when Clist0 parse_ComponentTypeLists([{'...',L1}|Rest02],Clist0) -> parse_ComponentTypeLists2(Rest02,Clist0++[#'EXTENSIONMARK'{pos=L1}]); parse_ComponentTypeLists(Tokens = [{'}',_L1}|_Rest02],Clist0) -> - {Clist0,Tokens}. + {Clist0,Tokens}; +parse_ComponentTypeLists(Tokens, _) -> + throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), + [got,get_token(hd(Tokens)),expected, + identifier]}}). parse_ComponentTypeLists2(Tokens,Clist) -> {ExtAdd,Rest} = parse_ExtensionAdditions(Tokens,Clist), @@ -2916,7 +2923,7 @@ parse_SubtypeElements([{'PATTERN',_}|Tokens]) -> parse_SubtypeElements(Tokens) -> Flist = [fun parse_ContainedSubtype/1, fun parse_Value/1, - fun([{'MIN',_}|T]) -> {'MIN',T} end, + fun parse_MIN/1, fun parse_Type/1], case (catch parse_or(Tokens,Flist)) of {'EXIT',Reason} -> @@ -2952,8 +2959,8 @@ parse_UpperEndpoint(Tokens) -> parse_UpperEndpoint(false,Tokens). parse_UpperEndpoint(Lt,Tokens) -> - Flist = [ fun([{'MAX',_}|T]) -> {'MAX',T} end, - fun parse_Value/1], + Flist = [fun parse_MAX/1, + fun parse_Value/1], case (catch parse_or(Tokens,Flist)) of {'EXIT',Reason} -> exit(Reason); @@ -2965,6 +2972,18 @@ parse_UpperEndpoint(Lt,Tokens) -> {Value,Rest2} end. +parse_MIN([{'MIN',_}|T]) -> + {'MIN',T}; +parse_MIN([H|_]) -> + throw({asn1_error,{get_line(H),get(asn1_module), + [got,get_token(H),expected,'MIN']}}). + +parse_MAX([{'MAX',_}|T]) -> + {'MAX',T}; +parse_MAX([H|_]) -> + throw({asn1_error,{get_line(H),get(asn1_module), + [got,get_token(H),expected,'MAX']}}). + parse_TypeConstraints(Tokens) -> parse_TypeConstraints(Tokens,[]). -- cgit v1.2.3 From f548abfb7ef76ddf3828d5f90abe2f9df80d5b7c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 4 Dec 2014 10:43:11 +0100 Subject: asn1ct_parser2: Correct extraction of line number from token The first position in a token tuple is always an atom, the second the line number. The code tested the third position. --- lib/asn1/src/asn1ct_parser2.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl index f3a56e1b65..4e5c76539d 100644 --- a/lib/asn1/src/asn1ct_parser2.erl +++ b/lib/asn1/src/asn1ct_parser2.erl @@ -3032,7 +3032,7 @@ merge_constraints([], Cacc, []) -> merge_constraints([], Cacc, Eacc) -> lists:reverse(Cacc) ++ [{element_set,{'Errors',Eacc},none}]. -get_line({_,Pos,Token}) when is_integer(Pos),is_atom(Token) -> +get_line({Token,Pos,_}) when is_integer(Pos), is_atom(Token) -> Pos; get_line({Token,Pos}) when is_integer(Pos),is_atom(Token) -> Pos; -- cgit v1.2.3 From 0aaff8007df99512acb300f610283523d9f05945 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 3 Dec 2014 08:41:02 +0100 Subject: asn1ct_parser2: Clean up parse_or/3 and parse_or_tag/3 Use try...catch instead of catch. --- lib/asn1/src/asn1ct_parser2.erl | 78 +++++++++++++++-------------------------- 1 file changed, 29 insertions(+), 49 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl index 4e5c76539d..287201dbad 100644 --- a/lib/asn1/src/asn1ct_parser2.erl +++ b/lib/asn1/src/asn1ct_parser2.erl @@ -299,56 +299,32 @@ parse_Assignment(Tokens) -> parse_or(Tokens,Flist) -> parse_or(Tokens,Flist,[]). -parse_or(_Tokens,[],ErrList) -> - case ErrList of - [] -> - throw({asn1_error,{parse_or,ErrList}}); - L when is_list(L) -> - %% chose to throw 1) the error with the highest line no, - %% 2) the last error which is not a asn1_assignment_error or - %% 3) the last error. - throw(prioritize_error(ErrList)) +parse_or(Tokens, [Fun|Funs], ErrList) when is_function(Fun, 1) -> + try Fun(Tokens) of + {_,Rest}=Result when is_list(Rest) -> + Result + catch + throw:{asn1_error,_}=AsnErr -> + parse_or(Tokens, Funs, [AsnErr|ErrList]); + throw:{asn1_assignment_error,_}=AsnErr -> + parse_or(Tokens, Funs, [AsnErr|ErrList]) end; -parse_or(Tokens,[Fun|Frest],ErrList) -> - case (catch Fun(Tokens)) of - Exit = {'EXIT',_Reason} -> - parse_or(Tokens,Frest,[Exit|ErrList]); - AsnErr = {asn1_error,_} -> - parse_or(Tokens,Frest,[AsnErr|ErrList]); - AsnAssErr = {asn1_assignment_error,_} -> - parse_or(Tokens,Frest,[AsnAssErr|ErrList]); - Result = {_,L} when is_list(L) -> - Result; - Error -> - parse_or(Tokens,Frest,[Error|ErrList]) - end. - -parse_or_tag(Tokens,Flist) -> - parse_or_tag(Tokens,Flist,[]). - -parse_or_tag(_Tokens,[],ErrList) -> - case ErrList of - [] -> - throw({asn1_error,{parse_or_tag,ErrList}}); - L when is_list(L) -> - %% chose to throw 1) the error with the highest line no, - %% 2) the last error which is not a asn1_assignment_error or - %% 3) the last error. - throw(prioritize_error(ErrList)) +parse_or(_Tokens, [], ErrList) -> + throw(prioritize_error(ErrList)). + +parse_or_tag(Tokens, Flist) -> + parse_or_tag(Tokens, Flist, []). + +parse_or_tag(Tokens, [{Tag,Fun}|Funs], ErrList) when is_function(Fun, 1) -> + try Fun(Tokens) of + {Parsed,Rest} when is_list(Rest) -> + {{Tag,Parsed},Rest} + catch + throw:{asn1_error,_}=AsnErr -> + parse_or_tag(Tokens, Funs, [AsnErr|ErrList]) end; -parse_or_tag(Tokens,[{Tag,Fun}|Frest],ErrList) when is_function(Fun) -> - case (catch Fun(Tokens)) of - Exit = {'EXIT',_Reason} -> - parse_or_tag(Tokens,Frest,[Exit|ErrList]); - AsnErr = {asn1_error,_} -> - parse_or_tag(Tokens,Frest,[AsnErr|ErrList]); - AsnAssErr = {asn1_assignment_error,_} -> - parse_or_tag(Tokens,Frest,[AsnAssErr|ErrList]); - {ParseRes,Rest} when is_list(Rest) -> - {{Tag,ParseRes},Rest}; - Error -> - parse_or_tag(Tokens,Frest,[Error|ErrList]) - end. +parse_or_tag(_Tokens, [], ErrList) -> + throw(prioritize_error(ErrList)). parse_TypeAssignment([{typereference,L1,Tref},{'::=',_}|Rest]) -> {Type,Rest2} = parse_Type(Rest), @@ -3048,7 +3024,11 @@ get_token({Token,Pos}) when is_integer(Pos),is_atom(Token) -> get_token(_) -> undefined. -prioritize_error(ErrList) -> +%% Choose the "best" error: +%% 1) the error with the highest line number, +%% 2) the last error which is not an asn1_assignment_error, or +%% 3) the last error. +prioritize_error([_|_]=ErrList) -> case lists:keymember(asn1_error,1,ErrList) of false -> % only asn1_assignment_error -> take the last lists:last(ErrList); -- cgit v1.2.3 From b718f376519c89c60805b26efb54b4c4b5b8b908 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 3 Dec 2014 08:09:04 +0100 Subject: asn1ct_parser2: Eliminate all uses of old-style 'catch' Most uses of 'catch' are not necessary. For example, parse_or/2 is typically called like this: case catch parse_or(Tokens, Flist) of {'EXIT',Reason} -> exit(Reason); {asn1_error,_}=AsnErr -> throw(AsnErr); Result -> Result end. Since {asn1_error,_} is always thrown (never returned) and a successful is always returned (never thrown), the 'case' and the 'catch' are not necessary. The code can be simplified too: parse_or(Tokens, Flist) In a few cases, we will need to replace the 'catch' with 'try'...'catch'. --- lib/asn1/src/asn1ct_parser2.erl | 321 ++++++++-------------------------------- 1 file changed, 62 insertions(+), 259 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl index 287201dbad..65868642e6 100644 --- a/lib/asn1/src/asn1ct_parser2.erl +++ b/lib/asn1/src/asn1ct_parser2.erl @@ -180,10 +180,11 @@ parse_SymbolsFromModuleList(Tokens) -> parse_SymbolsFromModuleList(Tokens,Acc) -> {SymbolsFromModule,Rest} = parse_SymbolsFromModule(Tokens), - case (catch parse_SymbolsFromModule(Rest)) of + try parse_SymbolsFromModule(Rest) of {Sl,_Rest2} when is_record(Sl,'SymbolsFromModule') -> - parse_SymbolsFromModuleList(Rest,[SymbolsFromModule|Acc]); - _ -> + parse_SymbolsFromModuleList(Rest,[SymbolsFromModule|Acc]) + catch + throw:{asn1_error,_} -> {lists:reverse([SymbolsFromModule|Acc]),Rest} end. @@ -284,15 +285,12 @@ parse_Assignment(Tokens) -> fun parse_ObjectSetAssignment/1, fun parse_ParameterizedAssignment/1, fun parse_ValueSetTypeAssignment/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - {asn1_assignment_error,Reason} -> - throw({asn1_error,Reason}); - Result -> + try parse_or(Tokens, Flist) of + {_,_}=Result -> Result + catch + throw:{asn1_assignment_error,Reason} -> + throw({asn1_error,Reason}) end. @@ -361,14 +359,7 @@ parse_Type(Tokens) -> {Tag,Rest31} end, Flist = [fun parse_BuiltinType/1,fun parse_ReferencedType/1,fun parse_TypeWithConstraint/1], - {Type,Rest5} = case (catch parse_or(Rest4,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_Reason} -> - throw(AsnErr); - Result -> - Result - end, + {Type,Rest5} = parse_or(Rest4, Flist), case Rest5 of [{'(',_}|_] -> {Constraints,Rest6} = parse_Constraints(Rest5), @@ -686,32 +677,21 @@ parse_ReferencedType(Tokens) -> Flist = [fun parse_DefinedType/1, fun parse_SelectionType/1, fun parse_TypeFromObject/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. + parse_or(Tokens, Flist). parse_DefinedType(Tokens=[{typereference,_,_},{'{',_}|_Rest]) -> parse_ParameterizedType(Tokens); parse_DefinedType(Tokens=[{typereference,L1,TypeName}, T2={typereference,_,_},T3={'{',_}|Rest]) -> - case (catch parse_ParameterizedType(Tokens)) of - {'EXIT',_Reason} -> - Rest2 = [T2,T3|Rest], - {#type{def = #'Externaltypereference'{pos=L1, - module=resolve_module(TypeName), - type=TypeName}},Rest2}; - {asn1_error,_} -> + try parse_ParameterizedType(Tokens) of + {_,_}=Result -> + Result + catch + throw:{asn1_error,_} -> Rest2 = [T2,T3|Rest], {#type{def = #'Externaltypereference'{pos=L1, module=resolve_module(TypeName), - type=TypeName}},Rest2}; - Result -> - Result + type=TypeName}},Rest2} end; parse_DefinedType(Tokens=[{typereference,_L1,_Module},{'.',_}, {typereference,_,_TypeName},{'{',_}|_Rest]) -> @@ -799,14 +779,7 @@ parse_Constraint(Tokens) -> parse_ConstraintSpec(Tokens) -> Flist = [fun parse_GeneralConstraint/1, fun parse_SubtypeConstraint/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - {asn1_error,Reason2} -> - throw({asn1_error,Reason2}); - Result -> - Result - end. + parse_or(Tokens, Flist). parse_ExceptionSpec([LPar={')',_}|Rest]) -> {undefined,[LPar|Rest]}; @@ -820,14 +793,7 @@ parse_ExceptionIdentification(Tokens) -> Flist = [fun parse_SignedNumber/1, fun parse_DefinedValue/1, fun parse_TypeColonValue/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - {asn1_error,Reason2} -> - throw({asn1_error,Reason2}); - Result -> - Result - end. + parse_or(Tokens, Flist). parse_TypeColonValue(Tokens) -> {Type,Rest} = parse_Type(Tokens), @@ -952,19 +918,7 @@ parse_Elements(Tokens) -> % fun parse_Type/1, fun parse_Object/1, fun parse_DefinedObjectSet/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - Err = {asn1_error,_} -> - throw(Err); - Result = {Val,_} when is_record(Val,type) -> - Result; - - Result -> - Result - end. - - + parse_or(Tokens, Flist). %% -------------------------- @@ -997,14 +951,7 @@ parse_ObjectClass(Tokens) -> Flist = [fun parse_DefinedObjectClass/1, fun parse_ObjectClassDefn/1, fun parse_ParameterizedObjectClass/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - {asn1_error,Reason2} -> - throw({asn1_error,Reason2}); - Result -> - Result - end. + parse_or(Tokens, Flist). parse_ObjectClassDefn([{'CLASS',_},{'{',_}|Rest]) -> {Type,Rest2} = parse_FieldSpec(Rest), @@ -1025,11 +972,7 @@ parse_FieldSpec(Tokens,Acc) -> fun parse_VariableTypeValueSetFieldSpec/1, fun parse_TypeFieldSpec/1, fun parse_ObjectSetFieldSpec/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); + case parse_or(Tokens, Flist) of {Type,[{'}',_}|Rest]} -> {lists:reverse([Type|Acc]),Rest}; {Type,[{',',_}|Rest2]} -> @@ -1052,16 +995,10 @@ parse_FieldName(Tokens) -> {Field,Rest} = parse_PrimitiveFieldName(Tokens), parse_FieldName(Rest,[Field]). -parse_FieldName([{'.',_}|Rest],Acc) -> - case (catch parse_PrimitiveFieldName(Rest)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - {FieldName,Rest2} -> - parse_FieldName(Rest2,[FieldName|Acc]) - end; -parse_FieldName(Tokens,Acc) -> +parse_FieldName([{'.',_}|Rest0],Acc) -> + {FieldName,Rest1} = parse_PrimitiveFieldName(Rest0), + parse_FieldName(Rest1, [FieldName|Acc]); +parse_FieldName(Tokens, Acc) -> {lists:reverse(Acc),Tokens}. parse_FixedTypeValueFieldSpec([{valuefieldreference,L1,VFieldName}|Rest]) -> @@ -1243,14 +1180,7 @@ parse_SyntaxList(Tokens,Acc) -> parse_TokenOrGroupSpec(Tokens) -> Flist = [fun parse_RequiredToken/1, fun parse_OptionalGroup/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. + parse_or(Tokens, Flist). parse_RequiredToken([{typereference,L1,WordName}|Rest]) -> case is_word(WordName) of @@ -1321,26 +1251,12 @@ parse_Object(Tokens) -> fun parse_ObjectFromObject/1, fun parse_ParameterizedObject/1, fun parse_DefinedObject/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. + parse_or(Tokens, Flist). parse_ObjectDefn(Tokens) -> Flist=[fun parse_DefaultSyntax/1, fun parse_DefinedSyntax/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. + parse_or(Tokens, Flist). parse_DefaultSyntax([{'{',_},{'}',_}|Rest]) -> {{object,defaultsyntax,[]},Rest}; @@ -1393,17 +1309,9 @@ parse_DefinedSyntaxToken([{',',L1}|Rest]) -> %% Should also be able to parse a parameterized type. It may be %% impossible to distinguish between a parameterized type and a Literal %% followed by an object set. -parse_DefinedSyntaxToken(Tokens=[{typereference,L1,_Name},{T,_}|_Rest]) - when T == '.'; T == '(' -> - case catch parse_Setting(Tokens) of - {asn1_error,_} -> - throw({asn1_error,{L1,get(asn1_module), - [got,hd(Tokens), expected,['Word',setting]]}}); - {'EXIT',Reason} -> - exit(Reason); - Result -> - Result - end; +parse_DefinedSyntaxToken([{typereference,_,_Name},{T,_}|_]=Tokens) + when T =:= '.'; T =:= '(' -> + parse_Setting(Tokens); parse_DefinedSyntaxToken(Tokens=[TRef={typereference,L1,Name}|Rest]) -> case is_word(Name) of false -> @@ -1418,13 +1326,12 @@ parse_DefinedSyntaxToken(Tokens=[TRef={typereference,L1,Name}|Rest]) -> {{word_or_setting,L1,tref2Exttref(TRef)},Rest} end; parse_DefinedSyntaxToken(Tokens) -> - case catch parse_Setting(Tokens) of - {asn1_error,_} -> - parse_Word(Tokens); - {'EXIT',Reason} -> - exit(Reason); - Result -> + try parse_Setting(Tokens) of + {_,_}=Result -> Result + catch + throw:{asn1_error,_} -> + parse_Word(Tokens) end. lookahead_definedsyntax([{typereference,_,Name}|_Rest]) -> @@ -1451,14 +1358,12 @@ parse_Setting(Tokens) -> {value_tag,fun parse_Value/1}, {object_tag,fun parse_Object/1}, {objectset_tag,fun parse_ObjectSet/1}], - case (catch parse_or_tag(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result = {{value_tag,_},_} -> + case parse_or_tag(Tokens, Flist) of + {{value_tag,_},_}=Result -> + %% Keep the value_tag. Result; {{Tag,Setting},Rest} when is_atom(Tag) -> + %% Remove all other tags. {Setting,Rest} end. @@ -1552,14 +1457,7 @@ parse_ObjectSetElements(Tokens) -> %fun parse_DefinedObjectSet/1, fun parse_ObjectSetFromObjects/1, fun parse_ParameterizedObjectSet/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. + parse_or(Tokens, Flist). parse_ObjectClassFieldType(Tokens) -> {Class,Rest} = parse_DefinedObjectClass(Tokens), @@ -1633,14 +1531,7 @@ parse_ReferencedObjects(Tokens) -> fun parse_DefinedObjectSet/1, fun parse_ParameterizedObject/1, fun parse_ParameterizedObjectSet/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. + parse_or(Tokens, Flist). parse_ValueFromObject(Tokens) -> {Objects,Rest} = parse_ReferencedObjects(Tokens), @@ -1732,14 +1623,7 @@ parse_GeneralConstraint(Tokens) -> Flist = [fun parse_UserDefinedConstraint/1, fun parse_TableConstraint/1, fun parse_ContentsConstraint/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. + parse_or(Tokens, Flist). parse_UserDefinedConstraint([{'CONSTRAINED',_},{'BY',_},{'{',_},{'}',_}|Rest])-> {{constrained_by,[]},Rest}; @@ -1764,11 +1648,7 @@ parse_UserDefinedConstraintParameter(Tokens) -> parse_UserDefinedConstraintParameter(Tokens,Acc) -> Flist = [fun parse_GovernorAndActualParameter/1, fun parse_ActualParameter/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); + case parse_or(Tokens, Flist) of {Result,Rest} -> case Rest of [{',',_}|_Rest2] -> @@ -1792,14 +1672,7 @@ parse_GovernorAndActualParameter(Tokens) -> parse_TableConstraint(Tokens) -> Flist = [fun parse_ComponentRelationConstraint/1, fun parse_SimpleTableConstraint/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. + parse_or(Tokens, Flist). parse_SimpleTableConstraint(Tokens) -> {ObjectSet,Rest} = parse_ObjectSet(Tokens), @@ -1885,14 +1758,7 @@ parse_ContentsConstraint(Tokens) -> parse_Governor(Tokens) -> Flist = [fun parse_Type/1, fun parse_DefinedObjectClass/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. + parse_or(Tokens, Flist). parse_ActualParameter(Tokens) -> Flist = [fun parse_Type/1, @@ -1901,14 +1767,7 @@ parse_ActualParameter(Tokens) -> fun parse_DefinedObjectClass/1, fun parse_Object/1, fun parse_ObjectSet/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. + parse_or(Tokens, Flist). parse_ParameterizedAssignment(Tokens) -> Flist = [fun parse_ParameterizedTypeAssignment/1, @@ -1917,16 +1776,7 @@ parse_ParameterizedAssignment(Tokens) -> fun parse_ParameterizedObjectClassAssignment/1, fun parse_ParameterizedObjectAssignment/1, fun parse_ParameterizedObjectSetAssignment/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - AsnAssErr = {asn1_assignment_error,_} -> - throw(AsnAssErr); - Result -> - Result - end. + parse_or(Tokens, Flist). %% parse_ParameterizedTypeAssignment(Tokens) -> Result %% Result = {#ptypedef{},Rest} | throw() @@ -2070,14 +1920,7 @@ parse_ParameterList(Tokens,Acc) -> parse_Parameter(Tokens) -> Flist = [fun parse_ParamGovAndRef/1, fun parse_Reference/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. + parse_or(Tokens, Flist). parse_ParamGovAndRef(Tokens) -> {ParamGov,Rest} = parse_ParamGovernor(Tokens), @@ -2093,14 +1936,7 @@ parse_ParamGovAndRef(Tokens) -> parse_ParamGovernor(Tokens) -> Flist = [fun parse_Governor/1, fun parse_Reference/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. + parse_or(Tokens, Flist). % parse_ParameterizedReference(Tokens) -> % {Ref,Rest} = parse_Reference(Tokens), @@ -2648,11 +2484,7 @@ parse_NamedNumberList(Tokens,Acc) -> parse_NamedNumber([{identifier,_,Name},{'(',_}|Rest]) -> Flist = [fun parse_SignedNumber/1, fun parse_DefinedValue/1], - case (catch parse_or(Rest,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); + case parse_or(Rest, Flist) of {NamedNum,[{')',_}|Rest2]} -> {{'NamedNumber',Name,NamedNum},Rest2}; _ -> @@ -2701,15 +2533,7 @@ parse_Value(Tokens) -> Flist = [fun parse_BuiltinValue/1, fun parse_ValueFromObject/1, fun parse_DefinedValue/1], - - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end. + parse_or(Tokens, Flist). parse_BuiltinValue([{bstring,_,Bstr}|Rest]) -> {{bstring,Bstr},Rest}; @@ -2722,14 +2546,7 @@ parse_BuiltinValue(Tokens = [{'{',_}|_Rest]) -> fun parse_SequenceOfValue/1, fun parse_SequenceValue/1, fun parse_ObjectIdentifierValue/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - Result -> - Result - end; + parse_or(Tokens, Flist); parse_BuiltinValue([{identifier,_,IdName},{':',_}|Rest]) -> {Value,Rest2} = parse_Value(Rest), {{'CHOICE',{IdName,Value}},Rest2}; @@ -2841,15 +2658,9 @@ parse_ValueAssignment([{identifier,L1,IdName}|Rest]) -> case Rest2 of [{'::=',_}|Rest3] -> {Value,Rest4} = parse_Value(Rest3), - case catch lookahead_assignment(Rest4) of - ok -> - {#valuedef{pos=L1,name=IdName,type=Type,value=Value, - module=get(asn1_module)},Rest4}; - Error -> - throw(Error) -%% throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), -%% [got,get_token(hd(Rest2)),expected,'::=']}}) - end; + lookahead_assignment(Rest4), + {#valuedef{pos=L1,name=IdName,type=Type,value=Value, + module=get(asn1_module)},Rest4}; _ -> throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), [got,get_token(hd(Rest2)),expected,'::=']}}) @@ -2901,12 +2712,8 @@ parse_SubtypeElements(Tokens) -> fun parse_Value/1, fun parse_MIN/1, fun parse_Type/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - {asn1_error,Reason} -> - throw(Reason); - Result = {Val,_} when is_record(Val,type) -> + case parse_or(Tokens, Flist) of + {#type{},_}=Result -> Result; {Lower,[{'..',_}|Rest]} -> {Upper,Rest2} = parse_UpperEndpoint(Rest), @@ -2937,12 +2744,8 @@ parse_UpperEndpoint(Tokens) -> parse_UpperEndpoint(Lt,Tokens) -> Flist = [fun parse_MAX/1, fun parse_Value/1], - case (catch parse_or(Tokens,Flist)) of - {'EXIT',Reason} -> - exit(Reason); - AsnErr = {asn1_error,_} -> - throw(AsnErr); - {Value,Rest2} when Lt == lt -> + case parse_or(Tokens, Flist) of + {Value,Rest2} when Lt =:= lt -> {{lt,Value},Rest2}; {Value,Rest2} -> {Value,Rest2} @@ -3083,5 +2886,5 @@ identifier2Extvalueref(#identifier{pos=Pos,val=Name}) -> lookahead_assignment([{'END',_}|_Rest]) -> ok; lookahead_assignment(Tokens) -> - parse_Assignment(Tokens), + {_,_} = parse_Assignment(Tokens), ok. -- cgit v1.2.3 From 4247459eded419b9e693cfbfaf8746f4f6f60d2c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 3 Dec 2014 12:46:49 +0100 Subject: asn1ct, asn1ct_parser2: Refactor the upper levels of error handling Responsibilities for parse error handling were split between asn1ct and asn1ct_parser2 in a confusing way. Let asn1ct_parser2 return structured_error tuples in the same way as the check pass. --- lib/asn1/src/asn1ct.erl | 63 ++++--------------------------- lib/asn1/src/asn1ct_parser2.erl | 84 ++++++++++++++++++++++++++--------------- 2 files changed, 61 insertions(+), 86 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index cd7900f919..a26d63c97d 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -167,46 +167,26 @@ set_scan_parse_pass(#st{files=Files}=St) -> {error,St#st{error=Error}} end. -set_scan_parse_pass_1([F|Fs], St) -> +set_scan_parse_pass_1([F|Fs], #st{file=File}=St) -> case asn1ct_tok:file(F) of {error,Error} -> throw(Error); Tokens when is_list(Tokens) -> - case catch asn1ct_parser2:parse(Tokens) of + case asn1ct_parser2:parse(File, Tokens) of {ok,M} -> [M|set_scan_parse_pass_1(Fs, St)]; - {error,ErrorTerm} -> - throw(handle_parse_error(ErrorTerm, St)) + {error,Errors} -> + throw(Errors) end end; set_scan_parse_pass_1([], _) -> []. -parse_pass(#st{code=Tokens}=St) -> - case catch asn1ct_parser2:parse(Tokens) of +parse_pass(#st{file=File,code=Tokens}=St) -> + case asn1ct_parser2:parse(File, Tokens) of {ok,M} -> {ok,St#st{code=M}}; - {error,ErrorTerm} -> - {error,St#st{error=handle_parse_error(ErrorTerm, St)}} - end. - -handle_parse_error(ErrorTerm, #st{file=File,opts=Opts}) -> - case ErrorTerm of - {{Line,_Mod,Message},_TokTup} -> - if - is_integer(Line) -> - BaseName = filename:basename(File), - error("syntax error at line ~p in module ~s:~n", - [Line,BaseName], Opts); - true -> - error("syntax error in module ~p:~n", - [File], Opts) - end, - print_error_message(Message), - Message; - {Line,_Mod,[Message,Token]} -> - error("syntax error: ~p ~p at line ~p~n", - [Message,Token,Line], Opts), - {Line,[Message,Token]} + {error,Errors} -> + {error,St#st{error=Errors}} end. merge_pass(#st{file=Base,code=Code}=St) -> @@ -1410,33 +1390,6 @@ prepare_bytes(Bytes) -> list_to_binary(Bytes). vsn() -> ?vsn. - - -print_error_message([got,H|T]) when is_list(H) -> - io:format(" got:"), - print_listing(H,"and"), - print_error_message(T); -print_error_message([expected,H|T]) when is_list(H) -> - io:format(" expected one of:"), - print_listing(H,"or"), - print_error_message(T); -print_error_message([H|T]) -> - io:format(" ~p",[H]), - print_error_message(T); -print_error_message([]) -> - io:format("~n"). - -print_listing([H1,H2|[]],AndOr) -> - io:format(" ~p ~s ~p",[H1,AndOr,H2]); -print_listing([H1,H2|T],AndOr) -> - io:format(" ~p,",[H1]), - print_listing([H2|T],AndOr); -print_listing([H],_AndOr) -> - io:format(" ~p",[H]); -print_listing([],_) -> - ok. - - specialized_decode_prepare(Erule,M,TsAndVs,Options) -> case lists:member(asn1config,Options) of true -> diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl index 65868642e6..d1c0b7feda 100644 --- a/lib/asn1/src/asn1ct_parser2.erl +++ b/lib/asn1/src/asn1ct_parser2.erl @@ -20,7 +20,7 @@ %% -module(asn1ct_parser2). --export([parse/1]). +-export([parse/2,format_error/1]). -include("asn1_records.hrl"). %% Only used internally within this module. @@ -28,26 +28,29 @@ -record(constraint, {c,e}). -record(identifier, {pos,val}). -%% parse all types in module -parse(Tokens) -> - case catch parse_ModuleDefinition(Tokens) of - {'EXIT',Reason} -> - {error,{{undefined,get(asn1_module), - [internal,error,'when',parsing,module,definition,Reason]}, - hd(Tokens)}}; - {asn1_error,Reason} -> - {error,{Reason,hd(Tokens)}}; - {ModuleDefinition,Rest1} -> - {Types,Rest2} = parse_AssignmentList(Rest1), - clean_process_dictionary(), - case Rest2 of - [{'END',_}|_Rest3] -> - {ok,ModuleDefinition#module{typeorval = Types}}; - _ -> - {error,{{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'END']}, - hd(Rest2)}} - end +parse(File0, Tokens) -> + try do_parse(Tokens) of + {ok,#module{}}=Result -> + Result + catch + throw:{asn1_error,{Line,_Mod,Message}} -> + File = filename:basename(File0), + Error = {structured_error,{File,Line},?MODULE,Message}, + {error,[Error]} + after + clean_process_dictionary() + end. + +do_parse(Tokens0) -> + {ModuleDefinition,Tokens1} = parse_ModuleDefinition(Tokens0), + {Types,Tokens2} = parse_AssignmentList(Tokens1), + case Tokens2 of + [{'END',_}|_Rest3] -> + {ok,ModuleDefinition#module{typeorval=Types}}; + _ -> + throw({asn1_error, + {get_line(hd(Tokens2)),get(asn1_module), + [got,get_token(hd(Tokens2)),expected,'END']}}) end. clean_process_dictionary() -> @@ -57,6 +60,32 @@ clean_process_dictionary() -> _ = erase(extensiondefault), ok. +format_error(List) when is_list(List) -> + ["syntax error:"|print_error_message(List)]. + +print_error_message([got,H|T]) when is_list(H) -> + [" got:",print_listing(H, "and"), + print_error_message(T)]; +print_error_message([expected,H|T]) when is_list(H) -> + [" expected one of:", + print_listing(H, "or"), + print_error_message(T)]; +print_error_message([H|T]) -> + [io_lib:format(" ~p", [H]), + print_error_message(T)]; +print_error_message([]) -> + "\n". + +print_listing([H1,H2|[]], AndOr) -> + io_lib:format(" ~p ~s ~p",[H1,AndOr,H2]); +print_listing([H1,H2|T], AndOr) -> + [io_lib:format(" ~p,",[H1])|print_listing([H2|T], AndOr)]; +print_listing([H], _AndOr) -> + io_lib:format(" ~p", [H]); +print_listing([],_) -> + []. + + parse_ModuleDefinition([{typereference,L1,ModuleIdentifier}|Rest0]) -> put(asn1_module,ModuleIdentifier), {_DefinitiveIdentifier,Rest02} = @@ -266,16 +295,9 @@ parse_AssignmentList(Tokens= [{'END',_}|_Rest],Acc) -> {lists:reverse(Acc),Tokens}; parse_AssignmentList(Tokens= [{'$end',_}|_Rest],Acc) -> {lists:reverse(Acc),Tokens}; -parse_AssignmentList(Tokens,Acc) -> - case (catch parse_Assignment(Tokens)) of - {'EXIT',Reason} -> - exit(Reason); - {asn1_error,R} -> -% [H|T] = Tokens, - throw({error,{R,hd(Tokens)}}); - {Assignment,Rest} -> - parse_AssignmentList(Rest,[Assignment|Acc]) - end. +parse_AssignmentList(Tokens0, Acc) -> + {Assignment,Tokens} = parse_Assignment(Tokens0), + parse_AssignmentList(Tokens, [Assignment|Acc]). parse_Assignment(Tokens) -> Flist = [fun parse_TypeAssignment/1, -- cgit v1.2.3 From 7129f2acb474651fa4ef922b24ff18dd84dd9c77 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 4 Dec 2014 15:03:39 +0100 Subject: asn1ct_parser2: Clean up error handling and reporting Errors were reported using a throw like this: throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), [got,get_token(hd(Tokens)),expected,typereference]}}). The attempt to tell the user what was expected was often mis-leading. It is time-consuming and non-trival to provide correct information of what is expected. Therefore, we will not even try. Instead we will spend more effort to report the token where the error was discovered. We will replace each throw with a function call: parse_error(Tokens). Also add the syntax_SUITE test suite to test error reporting and to cover all error reporting code. Remove the old c_syntax/1 test case. Also remove all out-commented code. --- lib/asn1/src/asn1ct_check.erl | 2 - lib/asn1/src/asn1ct_parser2.erl | 1897 ++++++++++++++------------------------- 2 files changed, 649 insertions(+), 1250 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 7ed7da2ae7..23794f789a 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -527,8 +527,6 @@ check_class(S = #state{mname=M,tname=T},ClassSpec) end; check_class(S, #objectclass{}=C) -> check_objectclass(S, C); -check_class(_S,{poc,_ObjSet,_Params}) -> - 'fix this later'; check_class(S,ClassName) -> {RefMod,Def} = get_referenced_type(S,ClassName), case Def of diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl index d1c0b7feda..7a1c7230b3 100644 --- a/lib/asn1/src/asn1ct_parser2.erl +++ b/lib/asn1/src/asn1ct_parser2.erl @@ -28,19 +28,26 @@ -record(constraint, {c,e}). -record(identifier, {pos,val}). -parse(File0, Tokens) -> - try do_parse(Tokens) of +parse(File0, Tokens0) -> + try do_parse(Tokens0) of {ok,#module{}}=Result -> Result catch - throw:{asn1_error,{Line,_Mod,Message}} -> - File = filename:basename(File0), - Error = {structured_error,{File,Line},?MODULE,Message}, - {error,[Error]} + throw:{asn1_error,Fun} when is_function(Fun, 0) -> + handle_parse_error(File0, Fun()); + throw:{asn1_error,{parse_error,Tokens}} -> + handle_parse_error(File0, Tokens) after clean_process_dictionary() end. +handle_parse_error(File0, [Token|_]) -> + File = filename:basename(File0), + Line = get_line(Token), + Error = {structured_error,{File,Line},?MODULE, + {syntax_error,get_token(Token)}}, + {error,[Error]}. + do_parse(Tokens0) -> {ModuleDefinition,Tokens1} = parse_ModuleDefinition(Tokens0), {Types,Tokens2} = parse_AssignmentList(Tokens1), @@ -48,9 +55,7 @@ do_parse(Tokens0) -> [{'END',_}|_Rest3] -> {ok,ModuleDefinition#module{typeorval=Types}}; _ -> - throw({asn1_error, - {get_line(hd(Tokens2)),get(asn1_module), - [got,get_token(hd(Tokens2)),expected,'END']}}) + parse_error(Tokens2) end. clean_process_dictionary() -> @@ -60,31 +65,10 @@ clean_process_dictionary() -> _ = erase(extensiondefault), ok. -format_error(List) when is_list(List) -> - ["syntax error:"|print_error_message(List)]. - -print_error_message([got,H|T]) when is_list(H) -> - [" got:",print_listing(H, "and"), - print_error_message(T)]; -print_error_message([expected,H|T]) when is_list(H) -> - [" expected one of:", - print_listing(H, "or"), - print_error_message(T)]; -print_error_message([H|T]) -> - [io_lib:format(" ~p", [H]), - print_error_message(T)]; -print_error_message([]) -> - "\n". - -print_listing([H1,H2|[]], AndOr) -> - io_lib:format(" ~p ~s ~p",[H1,AndOr,H2]); -print_listing([H1,H2|T], AndOr) -> - [io_lib:format(" ~p,",[H1])|print_listing([H2|T], AndOr)]; -print_listing([H], _AndOr) -> - io_lib:format(" ~p", [H]); -print_listing([],_) -> - []. - +format_error({syntax_error,Token}) when is_atom(Token) -> + io_lib:format("syntax error before: '~s'", [Token]); +format_error({syntax_error,Token}) -> + io_lib:format("syntax error before: '~p'", [Token]). parse_ModuleDefinition([{typereference,L1,ModuleIdentifier}|Rest0]) -> put(asn1_module,ModuleIdentifier), @@ -99,9 +83,7 @@ parse_ModuleDefinition([{typereference,L1,ModuleIdentifier}|Rest0]) -> [{'DEFINITIONS',_}|Rest03] -> Rest03; _ -> - throw({asn1_error,{get_line(hd(Rest02)),get(asn1_module), - [got,get_token(hd(Rest02)), - expected,'DEFINITIONS']}}) + parse_error(Rest02) end, {TagDefault,Rest2} = case Rest of @@ -133,12 +115,11 @@ parse_ModuleDefinition([{typereference,L1,ModuleIdentifier}|Rest0]) -> extensiondefault = ExtensionDefault, exports = Exports, imports = {imports, Imports}}, Rest6}; - _ -> throw({asn1_error,{get_line(hd(Rest3)),get(asn1_module), - [got,get_token(hd(Rest3)),expected,"::= BEGIN"]}}) + _ -> + parse_error(Rest3) end; parse_ModuleDefinition(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,typereference]}}). + parse_error(Tokens). parse_Exports([{'EXPORTS',_L1},{';',_L2}|Rest]) -> {{exports,[]},Rest}; @@ -151,8 +132,7 @@ parse_Exports([{'EXPORTS',_L1}|Rest]) -> [{';',_}|Rest3] -> {{exports,SymbolList},Rest3}; _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,';']}}) + parse_error(Rest2) end; parse_Exports(Rest) -> {{exports,all},Rest}. @@ -166,29 +146,25 @@ parse_SymbolList(Tokens,Acc) -> [{',',_L1}|Rest2] -> parse_SymbolList(Rest2,[Symbol|Acc]); Rest2 -> - {lists:reverse([Symbol|Acc]),Rest2} + {lists:reverse(Acc, [Symbol]),Rest2} end. parse_Symbol(Tokens) -> parse_Reference(Tokens). parse_Reference([{typereference,L1,TrefName},{'{',_L2},{'}',_L3}|Rest]) -> -% {Tref,Rest}; {tref2Exttref(L1,TrefName),Rest}; parse_Reference([Tref1 = {typereference,_,_},{'.',_},Tref2 = {typereference,_,_}, {'{',_L2},{'}',_L3}|Rest]) -> -% {{Tref1,Tref2},Rest}; {{tref2Exttref(Tref1),tref2Exttref(Tref2)},Rest}; parse_Reference([Tref = {typereference,_L1,_TrefName}|Rest]) -> {tref2Exttref(Tref),Rest}; -parse_Reference([Vref = {identifier,_L1,_VName},{'{',_L2},{'}',_L3}|Rest]) -> +parse_Reference([#identifier{}=Vref,{'{',_L2},{'}',_L3}|Rest]) -> {identifier2Extvalueref(Vref),Rest}; -parse_Reference([Vref = {identifier,_L1,_VName}|Rest]) -> +parse_Reference([#identifier{}=Vref|Rest]) -> {identifier2Extvalueref(Vref),Rest}; parse_Reference(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - [typereference,identifier]]}}). + parse_error(Tokens). parse_Imports([{'IMPORTS',_L1},{';',_L2}|Rest]) -> {{imports,[]},Rest}; @@ -197,9 +173,8 @@ parse_Imports([{'IMPORTS',_L1}|Rest]) -> case Rest2 of [{';',_L2}|Rest3] -> {{imports,SymbolsFromModuleList},Rest3}; - Rest3 -> - throw({asn1_error,{get_line(hd(Rest3)),get(asn1_module), - [got,get_token(hd(Rest3)),expected,';']}}) + _ -> + parse_error(Rest2) end; parse_Imports(Tokens) -> {{imports,[]},Tokens}. @@ -211,10 +186,10 @@ parse_SymbolsFromModuleList(Tokens,Acc) -> {SymbolsFromModule,Rest} = parse_SymbolsFromModule(Tokens), try parse_SymbolsFromModule(Rest) of {Sl,_Rest2} when is_record(Sl,'SymbolsFromModule') -> - parse_SymbolsFromModuleList(Rest,[SymbolsFromModule|Acc]) + parse_SymbolsFromModuleList(Rest, [SymbolsFromModule|Acc]) catch throw:{asn1_error,_} -> - {lists:reverse([SymbolsFromModule|Acc]),Rest} + {lists:reverse(Acc, [SymbolsFromModule]),Rest} end. parse_SymbolsFromModule(Tokens) -> @@ -228,93 +203,111 @@ parse_SymbolsFromModule(Tokens) -> end, {SymbolList,Rest} = parse_SymbolList(Tokens), case Rest of - [{'FROM',_L1},Tref = {typereference,_,Name},Ref={identifier,_L2,_Id},C={',',_}|Rest2] -> - NewSymbolList = lists:map(SetRefModuleName(Name),SymbolList), + [{'FROM',_L1},{typereference,_,Name}=Tref| + [#identifier{},{',',_}|_]=Rest2] -> + NewSymbolList = lists:map(SetRefModuleName(Name), SymbolList), {#'SymbolsFromModule'{symbols=NewSymbolList, - module=tref2Exttref(Tref)},[Ref,C|Rest2]}; + module=tref2Exttref(Tref)},Rest2}; %% This a special case when there is only one Symbol imported %% from the next module. No other way to distinguish Ref from %% a part of the GlobalModuleReference of Name. - [{'FROM',_L1},Tref = {typereference,_,Name},Ref = {identifier,_L2,_Id},From = {'FROM',_}|Rest2] -> - NewSymbolList = lists:map(SetRefModuleName(Name),SymbolList), + [{'FROM',_L1},{typereference,_,Name}=Tref| + [#identifier{},{'FROM',_}|_]=Rest2] -> + NewSymbolList = lists:map(SetRefModuleName(Name), SymbolList), {#'SymbolsFromModule'{symbols=NewSymbolList, - module=tref2Exttref(Tref)},[Ref,From|Rest2]}; - [{'FROM',_L1},Tref = {typereference,_,Name},{identifier,_L2,_Id}|Rest2] -> - NewSymbolList = lists:map(SetRefModuleName(Name),SymbolList), + module=tref2Exttref(Tref)},Rest2}; + [{'FROM',_L1},{typereference,_,Name}=Tref,#identifier{}|Rest2] -> + NewSymbolList = lists:map(SetRefModuleName(Name), SymbolList), {#'SymbolsFromModule'{symbols=NewSymbolList, module=tref2Exttref(Tref)},Rest2}; - [{'FROM',_L1},Tref = {typereference,_,Name},Brace = {'{',_}|Rest2] -> - {_ObjIdVal,Rest3} = parse_ObjectIdentifierValue([Brace|Rest2]), % value not used yet, fix me - NewSymbolList = lists:map(SetRefModuleName(Name),SymbolList), + [{'FROM',_L1},{typereference,_,Name}=Tref|[{'{',_}|_]=Rest2] -> + {_ObjIdVal,Rest3} = parse_ObjectIdentifierValue(Rest2), % value not used yet, fix me + NewSymbolList = lists:map(SetRefModuleName(Name), SymbolList), {#'SymbolsFromModule'{symbols=NewSymbolList, module=tref2Exttref(Tref)},Rest3}; - [{'FROM',_L1},Tref = {typereference,_,Name}|Rest2] -> - NewSymbolList = lists:map(SetRefModuleName(Name),SymbolList), + [{'FROM',_L1},{typereference,_,Name}=Tref|Rest2] -> + NewSymbolList = lists:map(SetRefModuleName(Name), SymbolList), {#'SymbolsFromModule'{symbols=NewSymbolList, module=tref2Exttref(Tref)},Rest2}; _ -> - throw({asn1_error,{get_line(hd(Rest)),get(asn1_module), - [got,get_token(hd(Rest)),expected, - ['FROM typerefernece identifier ,', - 'FROM typereference identifier', - 'FROM typereference {', - 'FROM typereference']]}}) + parse_error(Rest) end. parse_ObjectIdentifierValue([{'{',_}|Rest]) -> parse_ObjectIdentifierValue(Rest,[]). -parse_ObjectIdentifierValue([{number,_,Num}|Rest],Acc) -> +parse_ObjectIdentifierValue([{number,_,Num}|Rest], Acc) -> parse_ObjectIdentifierValue(Rest,[Num|Acc]); -parse_ObjectIdentifierValue([{identifier,_,Id},{'(',_}, {number,_,Num}, {')',_}|Rest],Acc) -> +parse_ObjectIdentifierValue([#identifier{val=Id},{'(',_},{number,_,Num},{')',_}|Rest], Acc) -> parse_ObjectIdentifierValue(Rest,[{'NamedNumber',Id,Num}|Acc]); -parse_ObjectIdentifierValue([{identifier,_,Id},{'(',_}, {identifier,_,Id2}, {')',_}|Rest],Acc) -> +parse_ObjectIdentifierValue([#identifier{val=Id},{'(',_},#identifier{val=Id2},{')',_}|Rest], Acc) -> parse_ObjectIdentifierValue(Rest,[{'NamedNumber',Id,Id2}|Acc]); -parse_ObjectIdentifierValue([{identifier,_,Id},{'(',_}, {typereference,_,Tref},{'.',_},{identifier,_,Id2}, {')',_}|Rest],Acc) -> - parse_ObjectIdentifierValue(Rest,[{'NamedNumber',Id,{'ExternalValue',Tref,Id2}}|Acc]); -parse_ObjectIdentifierValue([Id = {identifier,_,_}|Rest],Acc) -> - parse_ObjectIdentifierValue(Rest,[identifier2Extvalueref(Id)|Acc]); -parse_ObjectIdentifierValue([{'}',_}|Rest],Acc) -> +parse_ObjectIdentifierValue([#identifier{val=Id},{'(',_},{typereference,_,Tref},{'.',_},#identifier{val=Id2}, {')',_}|Rest], Acc) -> + parse_ObjectIdentifierValue(Rest, [{'NamedNumber',Id,{'ExternalValue',Tref,Id2}}|Acc]); +parse_ObjectIdentifierValue([#identifier{}=Id|Rest], Acc) -> + parse_ObjectIdentifierValue(Rest, [identifier2Extvalueref(Id)|Acc]); +parse_ObjectIdentifierValue([{'}',_}|Rest], Acc) -> {lists:reverse(Acc),Rest}; -parse_ObjectIdentifierValue([H|_T],_Acc) -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected, - ['{ some of the following }',number,'identifier ( number )', - 'identifier ( identifier )', - 'identifier ( typereference.identifier)',identifier]]}}). +parse_ObjectIdentifierValue(Tokens, _Acc) -> + parse_error(Tokens). -parse_AssignmentList(Tokens = [{'END',_}|_Rest]) -> - {[],Tokens}; -parse_AssignmentList(Tokens = [{'$end',_}|_Rest]) -> - {[],Tokens}; parse_AssignmentList(Tokens) -> - parse_AssignmentList(Tokens,[]). + parse_AssignmentList(Tokens, []). -parse_AssignmentList(Tokens= [{'END',_}|_Rest],Acc) -> +parse_AssignmentList([{'END',_}|_]=Tokens, Acc) -> {lists:reverse(Acc),Tokens}; -parse_AssignmentList(Tokens= [{'$end',_}|_Rest],Acc) -> +parse_AssignmentList([{'$end',_}|_]=Tokens, Acc) -> {lists:reverse(Acc),Tokens}; parse_AssignmentList(Tokens0, Acc) -> {Assignment,Tokens} = parse_Assignment(Tokens0), parse_AssignmentList(Tokens, [Assignment|Acc]). -parse_Assignment(Tokens) -> - Flist = [fun parse_TypeAssignment/1, - fun parse_ValueAssignment/1, - fun parse_ObjectClassAssignment/1, - fun parse_ObjectAssignment/1, - fun parse_ObjectSetAssignment/1, - fun parse_ParameterizedAssignment/1, +parse_Assignment([{typereference,L1,Name},{'::=',_}|Tokens0]) -> + %% 1) Type ::= TypeDefinition + %% 2) CLASS-NAME ::= CLASS {...} + Flist = [{type,fun parse_Type/1}, + {class,fun parse_ObjectClass/1}], + case parse_or_tag(Tokens0, Flist) of + {{type,Type},Tokens} -> + %% TypeAssignment + {#typedef{pos=L1,name=Name,typespec=Type},Tokens}; + {{class,Type},Tokens} -> + %% ObjectClassAssignment + {#classdef{pos=L1,name=Name,module=resolve_module(Type), + typespec=Type},Tokens} + end; +parse_Assignment([{typereference,_,_},{'{',_}|_]=Tokens) -> + %% 1) Type{...} ::= ... + %% 2) ValueSet{...} Type ::= ... + %% ObjectSet{...} CLASS-NAME ::= CLASS {...} + %% 3) CLASS-NAME{...} ::= CLASS {...} + %% A parameterized value set and and a parameterized object set + %% cannot be distinguished from each other without type information. + Flist = [fun parse_ParameterizedTypeAssignment/1, + fun parse_ParameterizedValueSetTypeAssignment/1, + fun parse_ParameterizedObjectClassAssignment/1], + parse_or(Tokens, Flist); +parse_Assignment([{typereference,_,_}|_]=Tokens) -> + %% 1) ObjectSet CLASS-NAME ::= ... + %% 2) ValueSet Type ::= ... + Flist = [fun parse_ObjectSetAssignment/1, fun parse_ValueSetTypeAssignment/1], - try parse_or(Tokens, Flist) of - {_,_}=Result -> - Result - catch - throw:{asn1_assignment_error,Reason} -> - throw({asn1_error,Reason}) - end. - + parse_or(Tokens, Flist); +parse_Assignment([#identifier{},{'{',_}|_]=Tokens) -> + %% 1) value{...} Type ::= ... + %% 2) object{...} CLASS-NAME ::= ... + Flist = [fun parse_ParameterizedValueAssignment/1, + fun parse_ParameterizedObjectAssignment/1], + parse_or(Tokens, Flist); +parse_Assignment([#identifier{}|_]=Tokens) -> + %% 1) value Type ::= ... + %% 2) object CLASS-NAME ::= ... + Flist = [fun parse_ValueAssignment/1, + fun parse_ObjectAssignment/1], + parse_or(Tokens, Flist); +parse_Assignment(Tokens) -> + parse_error(Tokens). parse_or(Tokens,Flist) -> parse_or(Tokens,Flist,[]). @@ -324,13 +317,11 @@ parse_or(Tokens, [Fun|Funs], ErrList) when is_function(Fun, 1) -> {_,Rest}=Result when is_list(Rest) -> Result catch - throw:{asn1_error,_}=AsnErr -> - parse_or(Tokens, Funs, [AsnErr|ErrList]); - throw:{asn1_assignment_error,_}=AsnErr -> - parse_or(Tokens, Funs, [AsnErr|ErrList]) + throw:{asn1_error,Error} -> + parse_or(Tokens, Funs, [Error|ErrList]) end; parse_or(_Tokens, [], ErrList) -> - throw(prioritize_error(ErrList)). + throw({asn1_error,fun() -> prioritize_error(ErrList) end}). parse_or_tag(Tokens, Flist) -> parse_or_tag(Tokens, Flist, []). @@ -340,23 +331,26 @@ parse_or_tag(Tokens, [{Tag,Fun}|Funs], ErrList) when is_function(Fun, 1) -> {Parsed,Rest} when is_list(Rest) -> {{Tag,Parsed},Rest} catch - throw:{asn1_error,_}=AsnErr -> - parse_or_tag(Tokens, Funs, [AsnErr|ErrList]) + throw:{asn1_error,Error} -> + parse_or_tag(Tokens, Funs, [Error|ErrList]) end; parse_or_tag(_Tokens, [], ErrList) -> - throw(prioritize_error(ErrList)). + throw({asn1_error,fun() -> prioritize_error(ErrList) end}). + +prioritize_error(Errors0) -> + Errors1 = prioritize_error_1(Errors0), + Errors2 = [{length(L),L} || L <- Errors1], + Errors = lists:sort(Errors2), + [Res|_] = [L || {_,L} <- Errors], + Res. + +prioritize_error_1([F|T]) when is_function(F, 0) -> + [F()|prioritize_error_1(T)]; +prioritize_error_1([{parse_error,Tokens}|T]) -> + [Tokens|prioritize_error_1(T)]; +prioritize_error_1([]) -> + []. -parse_TypeAssignment([{typereference,L1,Tref},{'::=',_}|Rest]) -> - {Type,Rest2} = parse_Type(Rest), - {#typedef{pos=L1,name=Tref,typespec=Type},Rest2}; -parse_TypeAssignment([H1,H2|_Rest]) -> - throw({asn1_assignment_error,{get_line(H1),get(asn1_module), - [got,[get_token(H1),get_token(H2)], expected, - typereference,'::=']}}); -parse_TypeAssignment([H|_T]) -> - throw({asn1_assignment_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected, - typereference]}}). %% parse_Type(Tokens) -> Ret %% @@ -366,9 +360,8 @@ parse_TypeAssignment([H|_T]) -> %% parse_Type(Tokens) -> {Tag,Rest3} = case Tokens of - [Lbr= {'[',_}|Rest] -> - parse_Tag([Lbr|Rest]); - Rest-> {[],Rest} + [{'[',_}|_] -> parse_Tag(Tokens); + _ -> {[],Tokens} end, {Tag2,Rest4} = case Rest3 of [{'IMPLICIT',_}|Rest31] when is_record(Tag,tag)-> @@ -380,7 +373,9 @@ parse_Type(Tokens) -> Rest31 -> {Tag,Rest31} end, - Flist = [fun parse_BuiltinType/1,fun parse_ReferencedType/1,fun parse_TypeWithConstraint/1], + Flist = [fun parse_BuiltinType/1, + fun parse_ReferencedType/1, + fun parse_TypeWithConstraint/1], {Type,Rest5} = parse_or(Rest4, Flist), case Rest5 of [{'(',_}|_] -> @@ -399,8 +394,7 @@ parse_BuiltinType([{'BIT',_},{'STRING',_}|Rest]) -> [{'}',_}|Rest4] -> {#type{def={'BIT STRING',NamedNumberList}},Rest4}; _ -> - throw({asn1_error,{get_line(hd(Rest3)),get(asn1_module), - [got,get_token(hd(Rest3)),expected,'}']}}) + parse_error(Rest3) end; _ -> {#type{def={'BIT STRING',[]}},Rest} @@ -415,41 +409,33 @@ parse_BuiltinType([{'CHARACTER',_},{'STRING',_}|Rest]) -> {#type{def='CHARACTER STRING'},Rest}; parse_BuiltinType([{'CHOICE',_},{'{',_}|Rest]) -> - {AlternativeTypeLists,Rest2} = parse_AlternativeTypeLists(Rest), - AlternativeTypeLists1 = - lists:filter(fun(#'ExtensionAdditionGroup'{}) -> false; - ('ExtensionAdditionGroupEnd') -> false; - (_) -> true - end,AlternativeTypeLists), + {L0,Rest2} = parse_AlternativeTypeLists(Rest), case Rest2 of [{'}',_}|Rest3] -> - AlternativeTypeLists2 = - case {[Ext||Ext = #'EXTENSIONMARK'{} <- AlternativeTypeLists1], - get(extensiondefault)} of - {[],'IMPLIED'} -> AlternativeTypeLists1 ++ [#'EXTENSIONMARK'{}]; - _ -> AlternativeTypeLists1 + NeedExt = not lists:keymember('EXTENSIONMARK', 1, L0) andalso + get(extensiondefault) =:= 'IMPLIED', + L = case NeedExt of + true -> + L0 ++ [#'EXTENSIONMARK'{}]; + false -> + L0 end, - - {#type{def={'CHOICE',AlternativeTypeLists2}},Rest3}; + {#type{def={'CHOICE',L}},Rest3}; _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'}']}}) + parse_error(Rest2) end; parse_BuiltinType([{'EMBEDDED',_},{'PDV',_}|Rest]) -> {#type{def='EMBEDDED PDV'},Rest}; parse_BuiltinType([{'ENUMERATED',_},{'{',_}|Rest]) -> - {Enumerations,Rest2} = parse_Enumerations(Rest,get(extensiondefault)), + {Enumerations,Rest2} = parse_Enumerations(Rest), case Rest2 of [{'}',_}|Rest3] -> {#type{def={'ENUMERATED',Enumerations}},Rest3}; _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'}']}}) + parse_error(Rest2) end; parse_BuiltinType([{'EXTERNAL',_}|Rest]) -> {#type{def='EXTERNAL'},Rest}; - -% InstanceOfType parse_BuiltinType([{'INSTANCE',_},{'OF',_}|Rest]) -> {DefinedObjectClass,Rest2} = parse_DefinedObjectClass(Rest), case Rest2 of @@ -460,9 +446,6 @@ parse_BuiltinType([{'INSTANCE',_},{'OF',_}|Rest]) -> _ -> {#type{def={'INSTANCE OF',DefinedObjectClass,[]}},Rest2} end; - -% parse_BuiltinType(Tokens) -> - parse_BuiltinType([{'INTEGER',_}|Rest]) -> case Rest of [{'{',_}|Rest2] -> @@ -471,17 +454,13 @@ parse_BuiltinType([{'INTEGER',_}|Rest]) -> [{'}',_}|Rest4] -> {#type{def={'INTEGER',NamedNumberList}},Rest4}; _ -> - throw({asn1_error,{get_line(hd(Rest3)),get(asn1_module), - [got,get_token(hd(Rest3)),expected,'}']}}) + parse_error(Rest3) end; _ -> {#type{def='INTEGER'},Rest} end; parse_BuiltinType([{'NULL',_}|Rest]) -> {#type{def='NULL'},Rest}; - -% ObjectClassFieldType fix me later - parse_BuiltinType([{'OBJECT',_},{'IDENTIFIER',_}|Rest]) -> {#type{def='OBJECT IDENTIFIER'},Rest}; parse_BuiltinType([{'OCTET',_},{'STRING',_}|Rest]) -> @@ -509,18 +488,14 @@ parse_BuiltinType([{'SEQUENCE',_},{'{',_},{'...',Line},{'!',_}|Rest]) -> parse_ComponentTypeLists2(Rest2,[#'EXTENSIONMARK'{pos=Line}]), case Rest3 of [{'}',_}|Rest4] -> - {#type{def=#'SEQUENCE'{components=ComponentTypeLists}},Rest4}; + {#type{def=#'SEQUENCE'{components=ComponentTypeLists}},Rest4}; _ -> - throw({asn1_error,{get_line(hd(Rest3)),get(asn1_module), - [got,get_token(hd(Rest3)),expected,'}']}}) + parse_error(Rest3) end -% _ -> % Seq case 4,17-19,23-26 will fail here -% throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), -% [got,get_token(hd(Rest2)),expected,'}']}}) end; parse_BuiltinType([{'SEQUENCE',_},{'{',_}|Rest]) -> {ComponentTypeLists,Rest2} = parse_ComponentTypeLists(Rest), - case Rest2 of + case Rest2 of [{'}',_}|Rest3] -> ComponentTypeLists2 = case {[Ext||Ext = #'EXTENSIONMARK'{} <- ComponentTypeLists], @@ -531,25 +506,19 @@ parse_BuiltinType([{'SEQUENCE',_},{'{',_}|Rest]) -> {#type{def=#'SEQUENCE'{components = ComponentTypeLists2}}, Rest3}; _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'}']}}) + parse_error(Rest2) end; - -parse_BuiltinType([{'SEQUENCE',_},{'OF',_},Id={identifier,_,_},Lt={'<',_}|Rest]) -> -%% TODO: take care of the identifier for something useful - {Type,Rest2} = parse_SelectionType([Id,Lt|Rest]), - {#type{def={'SEQUENCE OF',Type}},Rest2}; - -parse_BuiltinType([{'SEQUENCE',_},{'OF',_},{identifier,_,_} |Rest]) -> +parse_BuiltinType([{'SEQUENCE',_},{'OF',_}| + [#identifier{},{'<',_}|_]=Tokens0]) -> + {Type,Tokens} = parse_SelectionType(Tokens0), + {#type{def={'SEQUENCE OF',Type}},Tokens}; +parse_BuiltinType([{'SEQUENCE',_},{'OF',_},#identifier{} |Rest]) -> %% TODO: take care of the identifier for something useful {Type,Rest2} = parse_Type(Rest), {#type{def={'SEQUENCE OF',Type}},Rest2}; - parse_BuiltinType([{'SEQUENCE',_},{'OF',_}|Rest]) -> {Type,Rest2} = parse_Type(Rest), {#type{def={'SEQUENCE OF',Type}},Rest2}; - - parse_BuiltinType([{'SET',_},{'{',_},{'...',Line},{'}',_}|Rest]) -> {#type{def=#'SET'{components=[#'EXTENSIONMARK'{pos = Line}]}},Rest}; parse_BuiltinType([{'SET',_},{'{',_},{'...',Line},{'!',_}|Rest]) -> @@ -561,12 +530,18 @@ parse_BuiltinType([{'SET',_},{'{',_},{'...',Line},{'!',_}|Rest]) -> val = ExceptionIdentification}]}}, Rest3}; _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'}']}}) + {ComponentTypeLists,Rest3}= + parse_ComponentTypeLists2(Rest2,[#'EXTENSIONMARK'{pos=Line}]), + case Rest3 of + [{'}',_}|Rest4] -> + {#type{def=#'SET'{components=ComponentTypeLists}},Rest4}; + _ -> + parse_error(Rest3) + end end; parse_BuiltinType([{'SET',_},{'{',_}|Rest]) -> {ComponentTypeLists,Rest2} = parse_ComponentTypeLists(Rest), - case Rest2 of + case Rest2 of [{'}',_}|Rest3] -> ComponentTypeLists2 = case {[Ext||Ext = #'EXTENSIONMARK'{} <- ComponentTypeLists], @@ -577,164 +552,128 @@ parse_BuiltinType([{'SET',_},{'{',_}|Rest]) -> {#type{def=#'SET'{components = ComponentTypeLists2}}, Rest3}; _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'}']}}) + parse_error(Rest2) end; - -parse_BuiltinType([{'SET',_},{'OF',_},Id={identifier,_,_},Lt={'<',_}|Rest]) -> -%% TODO: take care of the identifier for something useful - {Type,Rest2} = parse_SelectionType([Id,Lt|Rest]), - {#type{def={'SET OF',Type}},Rest2}; - -parse_BuiltinType([{'SET',_},{'OF',_},{identifier,_,_}|Rest]) -> +parse_BuiltinType([{'SET',_},{'OF',_}| + [#identifier{},{'<',_}|_]=Tokens0]) -> + {Type,Tokens} = parse_SelectionType(Tokens0), + {#type{def={'SET OF',Type}},Tokens}; +parse_BuiltinType([{'SET',_},{'OF',_},#identifier{}|Rest]) -> %%TODO: take care of the identifier for something useful {Type,Rest2} = parse_Type(Rest), {#type{def={'SET OF',Type}},Rest2}; - parse_BuiltinType([{'SET',_},{'OF',_}|Rest]) -> {Type,Rest2} = parse_Type(Rest), {#type{def={'SET OF',Type}},Rest2}; - -%% The so called Useful types parse_BuiltinType([{'GeneralizedTime',_}|Rest]) -> {#type{def='GeneralizedTime'},Rest}; parse_BuiltinType([{'UTCTime',_}|Rest]) -> {#type{def='UTCTime'},Rest}; parse_BuiltinType([{'ObjectDescriptor',_}|Rest]) -> {#type{def='ObjectDescriptor'},Rest}; - -%% For compatibility with old standard -parse_BuiltinType([{'ANY',_},{'DEFINED',_},{'BY',_},{identifier,_,Id}|Rest]) -> +parse_BuiltinType([{'ANY',_},{'DEFINED',_},{'BY',_},#identifier{val=Id}|Rest]) -> + %% For compatibility with the old standard. {#type{def={'ANY_DEFINED_BY',Id}},Rest}; parse_BuiltinType([{'ANY',_}|Rest]) -> + %% For compatibility with the old standard. {#type{def='ANY'},Rest}; - parse_BuiltinType(Tokens) -> parse_ObjectClassFieldType(Tokens). -% throw({asn1_error,unhandled_type}). -parse_TypeWithConstraint([{'SEQUENCE',_},Lpar = {'(',_}|Rest]) -> - {Constraint,Rest2} = parse_Constraint([Lpar|Rest]), +parse_TypeWithConstraint([{'SEQUENCE',_}|[{'(',_}|_]=Rest0]) -> + {Constraint,Rest2} = parse_Constraint(Rest0), Rest4 = case Rest2 of - [{'OF',_}, {identifier,_,_Id}|Rest3] -> + [{'OF',_},#identifier{}|Rest3] -> %%% TODO: make some use of the identifier, maybe useful in the XML mapping Rest3; [{'OF',_}|Rest3] -> Rest3; _ -> - throw({asn1_error, - {get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'OF']}}) + parse_error(Rest2) end, {Type,Rest5} = parse_Type(Rest4), {#type{def = {'SEQUENCE OF',Type}, constraint = merge_constraints([Constraint])},Rest5}; -parse_TypeWithConstraint([{'SEQUENCE',_},{'SIZE',_},Lpar = {'(',_}|Rest]) -> - {Constraint,Rest2} = parse_Constraint([Lpar|Rest]), +parse_TypeWithConstraint([{'SEQUENCE',_},{'SIZE',_}|[{'(',_}|_]=Rest0]) -> + {Constraint,Rest2} = parse_Constraint(Rest0), #constraint{c=C} = Constraint, Constraint2 = Constraint#constraint{c={element_set,{'SizeConstraint',C}, none}}, Rest4 = case Rest2 of - [{'OF',_}, {identifier,_,_Id}|Rest3] -> + [{'OF',_},#identifier{}|Rest3] -> %%% TODO: make some use of the identifier, maybe useful in the XML mapping Rest3; [{'OF',_}|Rest3] -> Rest3; _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'OF']}}) + parse_error(Rest2) end, {Type,Rest5} = parse_Type(Rest4), {#type{def = {'SEQUENCE OF',Type}, constraint = merge_constraints([Constraint2])},Rest5}; -parse_TypeWithConstraint([{'SET',_},Lpar = {'(',_}|Rest]) -> - {Constraint,Rest2} = parse_Constraint([Lpar|Rest]), +parse_TypeWithConstraint([{'SET',_}|[{'(',_}|_]=Rest0]) -> + {Constraint,Rest2} = parse_Constraint(Rest0), Rest4 = case Rest2 of - [{'OF',_}, {identifier,_,_Id}|Rest3] -> + [{'OF',_},#identifier{}|Rest3] -> %%% TODO: make some use of the identifier, maybe useful in the XML mapping Rest3; [{'OF',_}|Rest3] -> Rest3; _ -> - throw({asn1_error, - {get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'OF']}}) + parse_error(Rest2) end, {Type,Rest5} = parse_Type(Rest4), {#type{def = {'SET OF',Type}, constraint = merge_constraints([Constraint])},Rest5}; -parse_TypeWithConstraint([{'SET',_},{'SIZE',_},Lpar = {'(',_}|Rest]) -> - {Constraint,Rest2} = parse_Constraint([Lpar|Rest]), +parse_TypeWithConstraint([{'SET',_},{'SIZE',_}|[{'(',_}|_]=Rest0]) -> + {Constraint,Rest2} = parse_Constraint(Rest0), #constraint{c=C} = Constraint, Constraint2 = Constraint#constraint{c={element_set, {'SizeConstraint',C},none}}, Rest4 = case Rest2 of - [{'OF',_}, {identifier,_,_Id}|Rest3] -> + [{'OF',_},#identifier{}|Rest3] -> %%% TODO: make some use of the identifier, maybe useful in the XML mapping Rest3; [{'OF',_}|Rest3] -> Rest3; _ -> - throw({asn1_error, - {get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'OF']}}) + parse_error(Rest2) end, {Type,Rest5} = parse_Type(Rest4), {#type{def = {'SET OF',Type}, constraint = merge_constraints([Constraint2])},Rest5}; parse_TypeWithConstraint(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - ['SEQUENCE','SEQUENCE SIZE','SET','SET SIZE'], - followed,by,a,constraint]}}). + parse_error(Tokens). %% -------------------------- parse_ReferencedType(Tokens) -> - Flist = [fun parse_DefinedType/1, + Flist = [fun parse_ParameterizedType/1, + fun parse_DefinedType/1, fun parse_SelectionType/1, fun parse_TypeFromObject/1], parse_or(Tokens, Flist). -parse_DefinedType(Tokens=[{typereference,_,_},{'{',_}|_Rest]) -> - parse_ParameterizedType(Tokens); -parse_DefinedType(Tokens=[{typereference,L1,TypeName}, - T2={typereference,_,_},T3={'{',_}|Rest]) -> - try parse_ParameterizedType(Tokens) of - {_,_}=Result -> - Result - catch - throw:{asn1_error,_} -> - Rest2 = [T2,T3|Rest], - {#type{def = #'Externaltypereference'{pos=L1, - module=resolve_module(TypeName), - type=TypeName}},Rest2} - end; -parse_DefinedType(Tokens=[{typereference,_L1,_Module},{'.',_}, - {typereference,_,_TypeName},{'{',_}|_Rest]) -> - parse_ParameterizedType(Tokens); -parse_DefinedType([{typereference,L1,Module},{'.',_},{typereference,_,TypeName}|Rest]) -> - {#type{def = #'Externaltypereference'{pos=L1,module=Module,type=TypeName}},Rest}; -parse_DefinedType([{typereference,L1,TypeName}|Rest]) -> - {#type{def = #'Externaltypereference'{pos=L1,module=resolve_module(TypeName), - type=TypeName}},Rest}; +parse_DefinedType([{typereference,L1,Module}, + {'.',_}, + {typereference,_,TypeName}|Tokens]) -> + {#type{def = #'Externaltypereference'{pos=L1,module=Module, + type=TypeName}},Tokens}; +parse_DefinedType([{typereference,_,_}=Tr|Tokens]) -> + {#type{def=tref2Exttref(Tr)},Tokens}; parse_DefinedType(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - [typereference,'typereference.typereference', - 'typereference typereference']]}}). + parse_error(Tokens). -parse_SelectionType([{identifier,_,Name},{'<',_}|Rest]) -> +parse_SelectionType([#identifier{val=Name},{'<',_}|Rest]) -> {Type,Rest2} = parse_Type(Rest), {#type{def={'SelectionType',Name,Type}},Rest2}; parse_SelectionType(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'identifier <']}}). + parse_error(Tokens). resolve_module(Type) -> @@ -747,30 +686,13 @@ resolve_module(_Type, Current, undefined) -> resolve_module(Type, Current, Imports) -> case [Mod || #'SymbolsFromModule'{symbols = S, module = Mod} <- Imports, #'Externaltypereference'{type = T} <- S, - Type == T] of + Type =:= T] of [#'Externaltypereference'{type = Mod}|_] -> Mod; %% This allows the same symbol to be imported several times %% which ought to be checked elsewhere and flagged as an error [] -> Current end. -%% -------------------------- - - -%% This should probably be removed very soon -% parse_ConstrainedType(Tokens) -> -% case (catch parse_TypeWithConstraint(Tokens)) of -% {'EXIT',Reason} -> -% {Type,Rest} = parse_Type(Tokens), -% {Constraint,Rest2} = parse_Constraint(Rest), -% {Type#type{constraint=Constraint},Rest2}; -% {asn1_error,Reason2} -> -% {Type,Rest} = parse_Type(Tokens), -% {Constraint,Rest2} = parse_Constraint(Rest), -% {Type#type{constraint=Constraint},Rest2}; -% Result -> -% Result -% end. parse_Constraints(Tokens) -> parse_Constraints(Tokens,[]). @@ -779,9 +701,9 @@ parse_Constraints(Tokens,Acc) -> {Constraint,Rest} = parse_Constraint(Tokens), case Rest of [{'(',_}|_Rest2] -> - parse_Constraints(Rest,[Constraint|Acc]); + parse_Constraints(Rest, [Constraint|Acc]); _ -> - {lists:reverse([Constraint|Acc]),Rest} + {lists:reverse(Acc, [Constraint]),Rest} end. parse_Constraint([{'(',_}|Rest]) -> @@ -790,13 +712,9 @@ parse_Constraint([{'(',_}|Rest]) -> case Rest3 of [{')',_}|Rest4] -> {#constraint{c=Constraint,e=Exception},Rest4}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,')']}}) - end; -parse_Constraint(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'(']}}). + [_|_] -> + parse_error(Rest3) + end. parse_ConstraintSpec(Tokens) -> Flist = [fun parse_GeneralConstraint/1, @@ -808,8 +726,7 @@ parse_ExceptionSpec([LPar={')',_}|Rest]) -> parse_ExceptionSpec([{'!',_}|Rest]) -> parse_ExceptionIdentification(Rest); parse_ExceptionSpec(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,[')','!']]}}). + parse_error(Tokens). parse_ExceptionIdentification(Tokens) -> Flist = [fun parse_SignedNumber/1, @@ -823,9 +740,8 @@ parse_TypeColonValue(Tokens) -> [{':',_}|Rest2] -> {Value,Rest3} = parse_Value(Rest2), {{Type,Value},Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,':']}}) + [_|_] -> + parse_error(Rest) end. parse_SubtypeConstraint(Tokens) -> @@ -929,15 +845,12 @@ parse_Elements([{'(',_}|Rest]) -> case Rest2 of [{')',_}|Rest3] -> {Elems,Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,')']}}) + [_|_] -> + parse_error(Rest2) end; parse_Elements(Tokens) -> Flist = [fun parse_ObjectSetElements/1, fun parse_SubtypeElements/1, -% fun parse_Value/1, -% fun parse_Type/1, fun parse_Object/1, fun parse_DefinedObjectSet/1], parse_or(Tokens, Flist). @@ -945,34 +858,20 @@ parse_Elements(Tokens) -> %% -------------------------- -parse_DefinedObjectClass([{typereference,_,_ModName},{'.',_},Tr={typereference,_,_ObjClName}|Rest]) -> -%% {{objectclassname,ModName,ObjClName},Rest}; -% {{objectclassname,tref2Exttref(Tr)},Rest}; - {tref2Exttref(Tr),Rest}; +parse_DefinedObjectClass([{typereference,_,ModName},{'.',_}, + {typereference,Pos,Name}|Tokens]) -> + Ext = #'Externaltypereference'{pos=Pos, + module=ModName, + type=Name}, + {Ext,Tokens}; parse_DefinedObjectClass([Tr={typereference,_,_ObjClName}|Rest]) -> -% {{objectclassname,tref2Exttref(Tr)},Rest}; {tref2Exttref(Tr),Rest}; parse_DefinedObjectClass(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - ['typereference . typereference', - typereference, - 'TYPE-IDENTIFIER', - 'ABSTRACT-SYNTAX']]}}). - -parse_ObjectClassAssignment([{typereference,L1,ObjClName},{'::=',_}|Rest]) -> - {Type,Rest2} = parse_ObjectClass(Rest), - {#classdef{pos=L1,name=ObjClName,module=resolve_module(Type), - typespec=Type},Rest2}; -parse_ObjectClassAssignment(Tokens) -> - throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - 'typereference ::=']}}). + parse_error(Tokens). parse_ObjectClass(Tokens) -> - Flist = [fun parse_DefinedObjectClass/1, - fun parse_ObjectClassDefn/1, - fun parse_ParameterizedObjectClass/1], + Flist = [fun parse_ObjectClassDefn/1, + fun parse_DefinedObjectClass/1], parse_or(Tokens, Flist). parse_ObjectClassDefn([{'CLASS',_},{'{',_}|Rest]) -> @@ -980,28 +879,39 @@ parse_ObjectClassDefn([{'CLASS',_},{'{',_}|Rest]) -> {WithSyntaxSpec,Rest3} = parse_WithSyntaxSpec(Rest2), {#objectclass{fields=Type,syntax=WithSyntaxSpec},Rest3}; parse_ObjectClassDefn(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'CLASS {']}}). + parse_error(Tokens). parse_FieldSpec(Tokens) -> parse_FieldSpec(Tokens,[]). -parse_FieldSpec(Tokens,Acc) -> - Flist = [fun parse_FixedTypeValueFieldSpec/1, - fun parse_VariableTypeValueFieldSpec/1, - fun parse_ObjectFieldSpec/1, - fun parse_FixedTypeValueSetFieldSpec/1, - fun parse_VariableTypeValueSetFieldSpec/1, - fun parse_TypeFieldSpec/1, - fun parse_ObjectSetFieldSpec/1], - case parse_or(Tokens, Flist) of +parse_FieldSpec(Tokens0, Acc) -> + Fl = case Tokens0 of + [{valuefieldreference,_,_}|_] -> + %% 1) &field Type + %% &object CLASS-NAME + %% 2) &field &FieldName + %% A fixed type field cannot be distinguished from + %% an object field without type information. + [fun parse_FixedTypeValueFieldSpec/1, + fun parse_VariableTypeValueFieldSpec/1]; + [{typefieldreference,_,_}|_] -> + %% 1) &Set Type + %% &ObjectSet CLASS-NAME + %% 2) &Set &FieldName + %% 3) &Type + %% A value set and an object cannot be distinguished + %% without type information. + [fun parse_FixedTypeValueSetFieldSpec/1, + fun parse_VariableTypeValueSetFieldSpec/1, + fun parse_TypeFieldSpec/1]; + [_|_] -> + parse_error(Tokens0) + end, + case parse_or(Tokens0, Fl) of {Type,[{'}',_}|Rest]} -> - {lists:reverse([Type|Acc]),Rest}; + {lists:reverse(Acc, [Type]),Rest}; {Type,[{',',_}|Rest2]} -> - parse_FieldSpec(Rest2,[Type|Acc]); - {_,[H|_T]} -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'}']}}) + parse_FieldSpec(Rest2, [Type|Acc]) end. parse_PrimitiveFieldName([{typefieldreference,_,FieldName}|Rest]) -> @@ -1009,9 +919,7 @@ parse_PrimitiveFieldName([{typefieldreference,_,FieldName}|Rest]) -> parse_PrimitiveFieldName([{valuefieldreference,_,FieldName}|Rest]) -> {{valuefieldreference,FieldName},Rest}; parse_PrimitiveFieldName(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - [typefieldreference,valuefieldreference]]}}). + parse_error(Tokens). parse_FieldName(Tokens) -> {Field,Rest} = parse_PrimitiveFieldName(Tokens), @@ -1023,7 +931,7 @@ parse_FieldName([{'.',_}|Rest0],Acc) -> parse_FieldName(Tokens, Acc) -> {lists:reverse(Acc),Tokens}. -parse_FixedTypeValueFieldSpec([{valuefieldreference,L1,VFieldName}|Rest]) -> +parse_FixedTypeValueFieldSpec([{valuefieldreference,_,VFieldName}|Rest]) -> {Type,Rest2} = parse_Type(Rest), {Unique,Rest3} = case Rest2 of @@ -1033,103 +941,61 @@ parse_FixedTypeValueFieldSpec([{valuefieldreference,L1,VFieldName}|Rest]) -> {undefined,Rest2} end, {OptionalitySpec,Rest5} = parse_ValueOptionalitySpec(Rest3), - case {Unique,Rest5} of - {'UNIQUE',[{Del,_}|_]} when Del =:= ','; Del =:= '}' -> - {{fixedtypevaluefield,VFieldName,Type,Unique, - OptionalitySpec},Rest5}; - {_,[{Del,_}|_]} when Del =:= ','; Del =:= '}' -> - {{object_or_fixedtypevalue_field,VFieldName,Type,Unique,OptionalitySpec},Rest5}; - _ -> - throw({asn1_error,{L1,get(asn1_module), - [got,get_token(hd(Rest5)),expected,[',','}']]}}) - end; -parse_FixedTypeValueFieldSpec(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,valuefieldreference]}}). + case is_end_delimiter(Rest5) of + false -> parse_error(Rest5); + true -> ok + end, + Tag = case Unique of + 'UNIQUE' -> fixedtypevaluefield; + _ -> object_or_fixedtypevalue_field + end, + {{Tag,VFieldName,Type,Unique,OptionalitySpec},Rest5}. + +parse_VariableTypeValueFieldSpec([{valuefieldreference,_,VFieldName}|Rest0]) -> + {FieldRef,Rest1} = parse_FieldName(Rest0), + {OptionalitySpec,Rest} = parse_ValueOptionalitySpec(Rest1), + case is_end_delimiter(Rest) of + true -> + {{variabletypevaluefield,VFieldName,FieldRef,OptionalitySpec}, + Rest}; + false -> + parse_error(Rest) + end. -parse_VariableTypeValueFieldSpec([{valuefieldreference,L,VFieldName}|Rest]) -> - {FieldRef,Rest2} = parse_FieldName(Rest), - {OptionalitySpec,Rest3} = parse_ValueOptionalitySpec(Rest2), - case Rest3 of - [{Del,_}|_] when Del =:= ','; Del =:= '}' -> - {{variabletypevaluefield,VFieldName,FieldRef,OptionalitySpec},Rest3}; - _ -> - throw({asn1_error,{L,get(asn1_module), - [got,get_token(hd(Rest3)),expected,[',','}']]}}) - end; -parse_VariableTypeValueFieldSpec(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,valuefieldreference]}}). +parse_TypeFieldSpec([{typefieldreference,_,Name}|Rest0]) -> + {OptionalitySpec,Rest} = parse_TypeOptionalitySpec(Rest0), + case is_end_delimiter(Rest) of + true -> + {{typefield,Name,OptionalitySpec},Rest}; + false -> + parse_error(Rest) + end. -parse_ObjectFieldSpec([{valuefieldreference,L,VFieldName}|Rest]) -> - {Class,Rest2} = parse_DefinedObjectClass(Rest), - {OptionalitySpec,Rest3} = parse_ObjectOptionalitySpec(Rest2), - case Rest3 of - [{Del,_}|_] when Del =:= ','; Del =:= '}' -> - {{objectfield,VFieldName,Class,undefined,OptionalitySpec},Rest3}; - _ -> - throw({asn1_error,{L,get(asn1_module), - [got,get_token(hd(Rest3)),expected,[',','}']]}}) - end; -parse_ObjectFieldSpec(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,valuefieldreference]}}). +parse_FixedTypeValueSetFieldSpec([{typefieldreference,_,Name}|Rest0]) -> + {Type,Rest1} = parse_Type(Rest0), + {OptionalitySpec,Rest} = parse_ValueSetOptionalitySpec(Rest1), + case is_end_delimiter(Rest) of + true -> + {{objectset_or_fixedtypevalueset_field,Name,Type, + OptionalitySpec},Rest}; + false -> + parse_error(Rest) + end. -parse_TypeFieldSpec([{typefieldreference,L,TFieldName}|Rest]) -> - {OptionalitySpec,Rest2} = parse_TypeOptionalitySpec(Rest), - case Rest2 of - [{Del,_}|_] when Del =:= ','; Del =:= '}' -> - {{typefield,TFieldName,OptionalitySpec},Rest2}; - _ -> - throw({asn1_error,{L,get(asn1_module), - [got,get_token(hd(Rest2)),expected,[',','}']]}}) - end; -parse_TypeFieldSpec(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,typefieldreference]}}). +parse_VariableTypeValueSetFieldSpec([{typefieldreference,_,Name}|Rest0]) -> + {FieldRef,Rest1} = parse_FieldName(Rest0), + {OptionalitySpec,Rest} = parse_ValueSetOptionalitySpec(Rest1), + case is_end_delimiter(Rest) of + true -> + {{variabletypevaluesetfield,Name,FieldRef,OptionalitySpec}, + Rest}; + false -> + parse_error(Rest) + end. -parse_FixedTypeValueSetFieldSpec([{typefieldreference,L,TFieldName}|Rest]) -> - {Type,Rest2} = parse_Type(Rest), - {OptionalitySpec,Rest3} = parse_ValueSetOptionalitySpec(Rest2), - case Rest3 of - [{Del,_}|_] when Del =:= ','; Del =:= '}' -> - {{objectset_or_fixedtypevalueset_field,TFieldName,Type, - OptionalitySpec},Rest3}; - _ -> - throw({asn1_error,{L,get(asn1_module), - [got,get_token(hd(Rest3)),expected,[',','}']]}}) - end; -parse_FixedTypeValueSetFieldSpec(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,typefieldreference]}}). - -parse_VariableTypeValueSetFieldSpec([{typefieldreference,L,TFieldName}|Rest]) -> - {FieldRef,Rest2} = parse_FieldName(Rest), - {OptionalitySpec,Rest3} = parse_ValueSetOptionalitySpec(Rest2), - case Rest3 of - [{Del,_}|_] when Del =:= ','; Del =:= '}' -> - {{variabletypevaluesetfield,TFieldName,FieldRef,OptionalitySpec},Rest3}; - _ -> - throw({asn1_error,{L,get(asn1_module), - [got,get_token(hd(Rest3)),expected,[',','}']]}}) - end; -parse_VariableTypeValueSetFieldSpec(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,typefieldreference]}}). - -parse_ObjectSetFieldSpec([{typefieldreference,L,TFieldName}|Rest]) -> - {Class,Rest2} = parse_DefinedObjectClass(Rest), - {OptionalitySpec,Rest3} = parse_ObjectSetOptionalitySpec(Rest2), - case Rest3 of - [{Del,_}|_] when Del =:= ','; Del =:= '}' -> - {{objectsetfield,TFieldName,Class,OptionalitySpec},Rest3}; - _ -> - throw({asn1_error,{L,get(asn1_module), - [got,get_token(hd(Rest3)),expected,[',','}']]}}) - end; -parse_ObjectSetFieldSpec(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,typefieldreference]}}). +is_end_delimiter([{',',_}|_]) -> true; +is_end_delimiter([{'}',_}|_]) -> true; +is_end_delimiter([_|_]) -> false. parse_ValueOptionalitySpec(Tokens)-> case Tokens of @@ -1140,15 +1006,6 @@ parse_ValueOptionalitySpec(Tokens)-> _ -> {'MANDATORY',Tokens} end. -parse_ObjectOptionalitySpec(Tokens) -> - case Tokens of - [{'OPTIONAL',_}|Rest] -> {'OPTIONAL',Rest}; - [{'DEFAULT',_}|Rest] -> - {Object,Rest2} = parse_Object(Rest), - {{'DEFAULT',Object},Rest2}; - _ -> {'MANDATORY',Tokens} - end. - parse_TypeOptionalitySpec(Tokens) -> case Tokens of [{'OPTIONAL',_}|Rest] -> {'OPTIONAL',Rest}; @@ -1167,36 +1024,24 @@ parse_ValueSetOptionalitySpec(Tokens) -> _ -> {'MANDATORY',Tokens} end. -parse_ObjectSetOptionalitySpec(Tokens) -> - case Tokens of - [{'OPTIONAL',_}|Rest] -> {'OPTIONAL',Rest}; - [{'DEFAULT',_}|Rest] -> - {ObjectSet,Rest2} = parse_ObjectSet(Rest), - {{'DEFAULT',ObjectSet},Rest2}; - _ -> {'MANDATORY',Tokens} - end. - parse_WithSyntaxSpec([{'WITH',_},{'SYNTAX',_}|Rest]) -> {SyntaxList,Rest2} = parse_SyntaxList(Rest), {{'WITH SYNTAX',SyntaxList},Rest2}; parse_WithSyntaxSpec(Tokens) -> {[],Tokens}. -parse_SyntaxList([{'{',_},{'}',_}|Rest]) -> - {[],Rest}; parse_SyntaxList([{'{',_}|Rest]) -> parse_SyntaxList(Rest,[]); parse_SyntaxList(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,['{}','{']]}}). + parse_error(Tokens). -parse_SyntaxList(Tokens,Acc) -> +parse_SyntaxList(Tokens, Acc) -> {SyntaxList,Rest} = parse_TokenOrGroupSpec(Tokens), case Rest of [{'}',_}|Rest2] -> - {lists:reverse([SyntaxList|Acc]),Rest2}; + {lists:reverse(Acc, [SyntaxList]),Rest2}; _ -> - parse_SyntaxList(Rest,[SyntaxList|Acc]) + parse_SyntaxList(Rest, [SyntaxList|Acc]) end. parse_TokenOrGroupSpec(Tokens) -> @@ -1204,21 +1049,19 @@ parse_TokenOrGroupSpec(Tokens) -> fun parse_OptionalGroup/1], parse_or(Tokens, Flist). -parse_RequiredToken([{typereference,L1,WordName}|Rest]) -> +parse_RequiredToken([{typereference,_,WordName}|Rest]=Tokens) -> case is_word(WordName) of false -> - throw({asn1_error,{L1,get(asn1_module), - [got,WordName,expected,a,'Word']}}); + parse_error(Tokens); true -> {WordName,Rest} end; parse_RequiredToken([{',',L1}|Rest]) -> {{',',L1},Rest}; -parse_RequiredToken([{WordName,L1}|Rest]) -> +parse_RequiredToken([{WordName,_}|Rest]=Tokens) -> case is_word(WordName) of false -> - throw({asn1_error,{L1,get(asn1_module), - [got,WordName,expected,a,'Word']}}); + parse_error(Tokens); true -> {WordName,Rest} end; @@ -1228,7 +1071,9 @@ parse_RequiredToken(Tokens) -> parse_OptionalGroup([{'[',_}|Rest]) -> {Spec,Rest2} = parse_TokenOrGroupSpec(Rest), {SpecList,Rest3} = parse_OptionalGroup(Rest2,[Spec]), - {SpecList,Rest3}. + {SpecList,Rest3}; +parse_OptionalGroup(Tokens) -> + parse_error(Tokens). parse_OptionalGroup([{']',_}|Rest],Acc) -> {lists:reverse(Acc),Rest}; @@ -1236,43 +1081,34 @@ parse_OptionalGroup(Tokens,Acc) -> {Spec,Rest} = parse_TokenOrGroupSpec(Tokens), parse_OptionalGroup(Rest,[Spec|Acc]). -parse_DefinedObject([Id={identifier,_,_ObjName}|Rest]) -> +parse_DefinedObject([#identifier{}=Id|Rest]) -> {{object,identifier2Extvalueref(Id)},Rest}; -parse_DefinedObject([{typereference,L1,ModName},{'.',_},{identifier,_,ObjName}|Rest]) -> +parse_DefinedObject([{typereference,L1,ModName},{'.',_},#identifier{val=ObjName}|Rest]) -> {{object, #'Externaltypereference'{pos=L1,module=ModName,type=ObjName}},Rest}; parse_DefinedObject(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - [identifier,'typereference.identifier']]}}). + parse_error(Tokens). -parse_ObjectAssignment([{identifier,L1,ObjName}|Rest]) -> +parse_ObjectAssignment([#identifier{pos=L1,val=ObjName}|Rest]) -> {Class,Rest2} = parse_DefinedObjectClass(Rest), case Rest2 of [{'::=',_}|Rest3] -> {Object,Rest4} = parse_Object(Rest3), {#typedef{pos=L1,name=ObjName, typespec=#'Object'{classname=Class,def=Object}},Rest4}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'::=']}}); - Other -> - throw({asn1_error,{L1,get(asn1_module), - [got,Other,expected,'::=']}}) - end; -parse_ObjectAssignment(Tokens) -> - throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,identifier]}}). - + _ -> + parse_error(Rest2) + end. %% parse_Object(Tokens) -> Ret %% Tokens = [Tok] %% Tok = tuple() %% Ret = {object,_} | {object, _, _} parse_Object(Tokens) -> - Flist=[fun parse_ObjectDefn/1, - fun parse_ObjectFromObject/1, - fun parse_ParameterizedObject/1, - fun parse_DefinedObject/1], + %% The ObjectFromObject production is not included here, + %% since it will have been catched by the ValueFromObject + %% before we reach this point. + Flist = [fun parse_ObjectDefn/1, + fun parse_DefinedObject/1], parse_or(Tokens, Flist). parse_ObjectDefn(Tokens) -> @@ -1280,24 +1116,20 @@ parse_ObjectDefn(Tokens) -> fun parse_DefinedSyntax/1], parse_or(Tokens, Flist). -parse_DefaultSyntax([{'{',_},{'}',_}|Rest]) -> - {{object,defaultsyntax,[]},Rest}; parse_DefaultSyntax([{'{',_}|Rest]) -> parse_DefaultSyntax(Rest,[]); parse_DefaultSyntax(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,['{}','{']]}}). + parse_error(Tokens). -parse_DefaultSyntax(Tokens,Acc) -> +parse_DefaultSyntax(Tokens, Acc) -> {Setting,Rest} = parse_FieldSetting(Tokens), case Rest of [{',',_}|Rest2] -> parse_DefaultSyntax(Rest2,[Setting|Acc]); [{'}',_}|Rest3] -> - {{object,defaultsyntax,lists:reverse([Setting|Acc])},Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,[',','}']]}}) + {{object,defaultsyntax,lists:reverse(Acc, [Setting])},Rest3}; + _ -> + parse_error(Rest) end. parse_FieldSetting(Tokens) -> @@ -1307,9 +1139,8 @@ parse_FieldSetting(Tokens) -> parse_DefinedSyntax([{'{',_}|Rest]) -> parse_DefinedSyntax(Rest, []); -parse_DefinedSyntax([H|_]) -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,['{']]}}). +parse_DefinedSyntax(Tokens) -> + parse_error(Tokens). parse_DefinedSyntax(Tokens,Acc) -> case Tokens of @@ -1325,8 +1156,8 @@ parse_DefinedSyntax(Tokens,Acc) -> %% Literal ::= word | ',' %% Setting ::= Type | Value | ValueSet | Object | ObjectSet %% word equals typereference, but no lower cases -parse_DefinedSyntaxToken([{',',L1}|Rest]) -> - {{',',L1},Rest}; +parse_DefinedSyntaxToken([{',',_}=Comma|Rest]) -> + {Comma,Rest}; %% ObjectClassFieldType or a defined type with a constraint. %% Should also be able to parse a parameterized type. It may be %% impossible to distinguish between a parameterized type and a Literal @@ -1334,17 +1165,16 @@ parse_DefinedSyntaxToken([{',',L1}|Rest]) -> parse_DefinedSyntaxToken([{typereference,_,_Name},{T,_}|_]=Tokens) when T =:= '.'; T =:= '(' -> parse_Setting(Tokens); -parse_DefinedSyntaxToken(Tokens=[TRef={typereference,L1,Name}|Rest]) -> +parse_DefinedSyntaxToken([{typereference,L1,Name}=TRef|Rest]=Tokens) -> case is_word(Name) of false -> case lookahead_definedsyntax(Rest) of word_or_setting -> {{setting,L1,tref2Exttref(TRef)},Rest}; - _ -> + setting -> parse_Setting(Tokens) end; true -> - %% {{word_or_setting,L1,Name},Rest} {{word_or_setting,L1,tref2Exttref(TRef)},Rest} end; parse_DefinedSyntaxToken(Tokens) -> @@ -1357,23 +1187,24 @@ parse_DefinedSyntaxToken(Tokens) -> end. lookahead_definedsyntax([{typereference,_,Name}|_Rest]) -> - case is_word(Name) of + case is_word(Name) of true -> word_or_setting; - _ -> setting + false -> setting end; lookahead_definedsyntax([{'}',_}|_Rest]) -> word_or_setting; lookahead_definedsyntax(_) -> setting. -parse_Word([{Name,Pos}|Rest]) -> +parse_Word([{Name,Pos}|Rest]=Tokens) -> case is_word(Name) of false -> - throw({asn1_error,{Pos,get(asn1_module), - [got,Name, expected,a,'Word']}}); + parse_error(Tokens); true -> {{word_or_setting,Pos,tref2Exttref(Pos,Name)},Rest} - end. + end; +parse_Word(Tokens) -> + parse_error(Tokens). parse_Setting(Tokens) -> Flist = [{type_tag,fun parse_Type/1}, @@ -1389,20 +1220,6 @@ parse_Setting(Tokens) -> {Setting,Rest} end. -%% parse_Setting(Tokens) -> -%% Flist = [fun parse_Type/1, -%% fun parse_Value/1, -%% fun parse_Object/1, -%% fun parse_ObjectSet/1], -%% case (catch parse_or(Tokens,Flist)) of -%% {'EXIT',Reason} -> -%% exit(Reason); -%% AsnErr = {asn1_error,_} -> -%% throw(AsnErr); -%% Result -> -%% Result -%% end. - parse_DefinedObjectSet([{typereference,L1,ModuleName},{'.',_}, {typereference,L2,ObjSetName}|Rest]) -> {{objectset,L1,#'Externaltypereference'{pos=L2,module=ModuleName, @@ -1411,9 +1228,7 @@ parse_DefinedObjectSet([{typereference,L1,ObjSetName}|Rest]) -> {{objectset,L1,#'Externaltypereference'{pos=L1,module=resolve_module(ObjSetName), type=ObjSetName}},Rest}; parse_DefinedObjectSet(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - [typereference,'typereference.typereference']]}}). + parse_error(Tokens). parse_ObjectSetAssignment([{typereference,L1,ObjSetName}|Rest]) -> {Class,Rest2} = parse_DefinedObjectClass(Rest), @@ -1423,16 +1238,9 @@ parse_ObjectSetAssignment([{typereference,L1,ObjSetName}|Rest]) -> {#typedef{pos=L1,name=ObjSetName, typespec=#'ObjectSet'{class=Class, set=ObjectSet}},Rest4}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'::=']}}) -%%% Other -> -%%% throw(Other) - end; -parse_ObjectSetAssignment(Tokens) -> - throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - typereference]}}). + _ -> + parse_error(Rest2) + end. %% parse_ObjectSet(Tokens) -> {Ret,Rest} %% Tokens = [Tok] @@ -1449,13 +1257,11 @@ parse_ObjectSet([{'{',_}|Rest]) -> case Rest2 of [{'}',_}|Rest3] -> {ObjSetSpec,Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'}']}}) + _ -> + parse_error(Rest2) end; parse_ObjectSet(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'{']}}). + parse_error(Tokens). parse_ObjectSetSpec([{'...',_},{',',_}|Tokens0]) -> {Elements,Tokens} = parse_ElementSetSpec(Tokens0), @@ -1465,7 +1271,6 @@ parse_ObjectSetSpec([{'...',_}|Tokens]) -> parse_ObjectSetSpec(Tokens) -> parse_ElementSetSpecs(Tokens). -% moved fun parse_Object/1 and fun parse_DefinedObjectSet/1 to parse_Elements %% parse_ObjectSetElements(Tokens) -> {Result,Rest} %% Result ::= {'ObjectSetFromObjects',Objects,Name} | {pos,ObjectSet,Params} %% Objects ::= ReferencedObjects @@ -1475,9 +1280,7 @@ parse_ObjectSetSpec(Tokens) -> %% ObjectSet ::= {objectset,integer(),#'Externaltypereference'{}} %% Params ::= list() (see parse_ActualParameterList/1) parse_ObjectSetElements(Tokens) -> - Flist = [%fun parse_Object/1, - %fun parse_DefinedObjectSet/1, - fun parse_ObjectSetFromObjects/1, + Flist = [fun parse_ObjectSetFromObjects/1, fun parse_ParameterizedObjectSet/1], parse_or(Tokens, Flist). @@ -1490,25 +1293,10 @@ parse_ObjectClassFieldType(Tokens) -> classname=Class, class=Class,fieldname=FieldName}, {#type{def=OCFT},Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'.']}}) -%%% Other -> -%%% throw(Other) + _ -> + parse_error(Rest) end. -%parse_ObjectClassFieldValue(Tokens) -> -% Flist = [fun parse_OpenTypeFieldVal/1, -% fun parse_FixedTypeFieldVal/1], -% case (catch parse_or(Tokens,Flist)) of -% {'EXIT',Reason} -> -% throw(Reason); -% AsnErr = {asn1_error,_} -> -% throw(AsnErr); -% Result -> -% Result -% end. - parse_ObjectClassFieldValue(Tokens) -> parse_OpenTypeFieldVal(Tokens). @@ -1518,28 +1306,10 @@ parse_OpenTypeFieldVal(Tokens) -> [{':',_}|Rest2] -> {Value,Rest3} = parse_Value(Rest2), {{opentypefieldvalue,Type,Value},Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,':']}}) + _ -> + parse_error(Rest) end. -% parse_FixedTypeFieldVal(Tokens) -> -% parse_Value(Tokens). - -% parse_InformationFromObjects(Tokens) -> -% Flist = [fun parse_ValueFromObject/1, -% fun parse_ValueSetFromObjects/1, -% fun parse_TypeFromObject/1, -% fun parse_ObjectFromObject/1], -% case (catch parse_or(Tokens,Flist)) of -% {'EXIT',Reason} -> -% throw(Reason); -% AsnErr = {asn1_error,_} -> -% throw(AsnErr); -% Result -> -% Result -% end. - %% parse_ReferencedObjects(Tokens) -> {Result,Rest} %% Result ::= DefObject | DefObjSet | %% {po,DefObject,Params} | {pos,DefObjSet,Params} | @@ -1551,11 +1321,11 @@ parse_OpenTypeFieldVal(Tokens) -> parse_ReferencedObjects(Tokens) -> Flist = [fun parse_DefinedObject/1, fun parse_DefinedObjectSet/1, - fun parse_ParameterizedObject/1, fun parse_ParameterizedObjectSet/1], parse_or(Tokens, Flist). parse_ValueFromObject(Tokens) -> + %% This production also matches ObjectFromObject. {Objects,Rest} = parse_ReferencedObjects(Tokens), case Rest of [{'.',_}|Rest2] -> @@ -1564,15 +1334,10 @@ parse_ValueFromObject(Tokens) -> {valuefieldreference,_} -> {{'ValueFromObject',Objects,Name},Rest3}; _ -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,typefieldreference,expected, - valuefieldreference]}}) + parse_error(Rest2) end; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'.']}}) -%%% Other -> -%%% throw({asn1_error,{got,Other,expected,'.'}}) + _ -> + parse_error(Rest) end. parse_TypeFromObject(Tokens) -> @@ -1584,26 +1349,10 @@ parse_TypeFromObject(Tokens) -> {typefieldreference,_FieldName} -> {#type{def={'TypeFromObject',Objects,Name}},Rest3}; _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected, - typefieldreference]}}) + parse_error(Rest2) end; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'.']}}) -%%% Other -> -%%% throw({asn1_error,{got,Other,expected,'.'}}) - end. - -parse_ObjectFromObject(Tokens) -> - {Objects,Rest} = parse_ReferencedObjects(Tokens), - case Rest of - [{'.',_}|Rest2] -> - {Name,Rest3} = parse_FieldName(Rest2), - {{'ObjectFromObject',Objects,Name},Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'.']}}) + _ -> + parse_error(Rest) end. %% parse_ObjectSetFromObjects(Tokens) -> {Result,Rest} @@ -1621,23 +1370,12 @@ parse_ObjectSetFromObjects(Tokens) -> {typefieldreference,_FieldName} -> {{'ObjectSetFromObjects',Objects,Name},Rest3}; _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected, - typefieldreference]}}) + parse_error(Rest2) end; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'.']}}) + _ -> + parse_error(Rest) end. -% parse_InstanceOfType([{'INSTANCE',_},{'OF',_}|Rest]) -> -% {Class,Rest2} = parse_DefinedObjectClass(Rest), -% {{'InstanceOfType',Class},Rest2}. - -% parse_InstanceOfValue(Tokens) -> -% parse_Value(Tokens). - - %% X.682 constraint specification @@ -1656,28 +1394,23 @@ parse_UserDefinedConstraint([{'CONSTRAINED',_}, case Rest2 of [{'}',_}|Rest3] -> {{constrained_by,Param},Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'}']}}) + _ -> + parse_error(Rest2) end; parse_UserDefinedConstraint(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - ['CONSTRAINED BY {}','CONSTRAINED BY {']]}}). + parse_error(Tokens). parse_UserDefinedConstraintParameter(Tokens) -> - parse_UserDefinedConstraintParameter(Tokens,[]). -parse_UserDefinedConstraintParameter(Tokens,Acc) -> + parse_UserDefinedConstraintParameter(Tokens, []). + +parse_UserDefinedConstraintParameter(Tokens0, Acc) -> Flist = [fun parse_GovernorAndActualParameter/1, fun parse_ActualParameter/1], - case parse_or(Tokens, Flist) of - {Result,Rest} -> - case Rest of - [{',',_}|_Rest2] -> - parse_UserDefinedConstraintParameter(Tokens,[Result|Acc]); - _ -> - {lists:reverse([Result|Acc]),Rest} - end + case parse_or(Tokens0, Flist) of + {Result,[{',',_}|Tokens]} -> + parse_UserDefinedConstraintParameter(Tokens, [Result|Acc]); + {Result,Tokens} -> + {lists:reverse(Acc, [Result]),Tokens} end. parse_GovernorAndActualParameter(Tokens) -> @@ -1686,9 +1419,8 @@ parse_GovernorAndActualParameter(Tokens) -> [{':',_}|Rest2] -> {Params,Rest3} = parse_ActualParameter(Rest2), {{'Governor_Params',Governor,Params},Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,':']}}) + _ -> + parse_error(Rest) end. parse_TableConstraint(Tokens) -> @@ -1711,20 +1443,14 @@ parse_ComponentRelationConstraint([{'{',_}|Rest]) -> {componentrelation,ObjectSet,AtNot}, none}, {Ret,Rest5}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'}']}}) + _ -> + parse_error(Rest4) end; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected, - 'ComponentRelationConstraint',ended,with,'}']}}) -%%% Other -> -%%% throw(Other) + _ -> + parse_error(Rest2) end; parse_ComponentRelationConstraint(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'{']}}). + parse_error(Tokens). parse_AtNotationList(Tokens,Acc) -> {AtNot,Rest} = parse_AtNotation(Tokens), @@ -1732,7 +1458,7 @@ parse_AtNotationList(Tokens,Acc) -> [{',',_}|Rest2] -> parse_AtNotationList(Rest2,[AtNot|Acc]); _ -> - {lists:reverse([AtNot|Acc]),Rest} + {lists:reverse(Acc, [AtNot]),Rest} end. parse_AtNotation([{'@',_},{'.',_}|Rest]) -> @@ -1742,20 +1468,17 @@ parse_AtNotation([{'@',_}|Rest]) -> {CIdList,Rest2} = parse_ComponentIdList(Rest), {{outermost,CIdList},Rest2}; parse_AtNotation(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,['@','@.']]}}). + parse_error(Tokens). parse_ComponentIdList(Tokens) -> parse_ComponentIdList(Tokens,[]). -parse_ComponentIdList([Id = {identifier,_,_},{'.',_}|Rest],Acc) -> +parse_ComponentIdList([#identifier{}=Id,{'.',_}|Rest], Acc) -> parse_ComponentIdList(Rest,[identifier2Extvalueref(Id)|Acc]); -parse_ComponentIdList([Id = {identifier,_,_}|Rest],Acc) -> - {lists:reverse([identifier2Extvalueref(Id)|Acc]),Rest}; +parse_ComponentIdList([#identifier{}=Id|Rest], Acc) -> + {lists:reverse(Acc, [identifier2Extvalueref(Id)]),Rest}; parse_ComponentIdList(Tokens,_) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - [identifier,'identifier.']]}}). + parse_error(Tokens). parse_ContentsConstraint([{'CONTAINING',_}|Rest]) -> {Type,Rest2} = parse_Type(Rest), @@ -1770,10 +1493,7 @@ parse_ContentsConstraint([{'ENCODED',_},{'BY',_}|Rest]) -> {Value,Rest2} = parse_Value(Rest), {{contentsconstraint,[],Value},Rest2}; parse_ContentsConstraint(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - 'CONTAINING','or','ENCODED BY']}}). - + parse_error(Tokens). % X.683 Parameterization of ASN.1 specifications @@ -1791,15 +1511,6 @@ parse_ActualParameter(Tokens) -> fun parse_ObjectSet/1], parse_or(Tokens, Flist). -parse_ParameterizedAssignment(Tokens) -> - Flist = [fun parse_ParameterizedTypeAssignment/1, - fun parse_ParameterizedValueAssignment/1, - fun parse_ParameterizedValueSetTypeAssignment/1, - fun parse_ParameterizedObjectClassAssignment/1, - fun parse_ParameterizedObjectAssignment/1, - fun parse_ParameterizedObjectSetAssignment/1], - parse_or(Tokens, Flist). - %% parse_ParameterizedTypeAssignment(Tokens) -> Result %% Result = {#ptypedef{},Rest} | throw() parse_ParameterizedTypeAssignment([{typereference,L1,Name}|Rest]) -> @@ -1809,18 +1520,13 @@ parse_ParameterizedTypeAssignment([{typereference,L1,Name}|Rest]) -> {Type,Rest4} = parse_Type(Rest3), {#ptypedef{pos=L1,name=Name,args=ParameterList,typespec=Type}, Rest4}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'::=']}}) - end; -parse_ParameterizedTypeAssignment(Tokens) -> - throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - typereference]}}). + _ -> + parse_error(Rest2) + end. %% parse_ParameterizedValueAssignment(Tokens) -> Result %% Result = {#pvaluedef{},Rest} | throw() -parse_ParameterizedValueAssignment([{identifier,L1,Name}|Rest]) -> +parse_ParameterizedValueAssignment([#identifier{pos=L1,val=Name}|Rest]) -> {ParameterList,Rest2} = parse_ParameterList(Rest), {Type,Rest3} = parse_Type(Rest2), case Rest3 of @@ -1828,13 +1534,9 @@ parse_ParameterizedValueAssignment([{identifier,L1,Name}|Rest]) -> {Value,Rest5} = parse_Value(Rest4), {#pvaluedef{pos=L1,name=Name,args=ParameterList,type=Type, value=Value},Rest5}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'::=']}}) - end; -parse_ParameterizedValueAssignment(Tokens) -> - throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,identifier]}}). + _ -> + parse_error(Rest3) + end. %% parse_ParameterizedValueSetTypeAssignment(Tokens) -> Result %% Result = {#pvaluesetdef{},Rest} | throw() @@ -1846,14 +1548,9 @@ parse_ParameterizedValueSetTypeAssignment([{typereference,L1,Name}|Rest]) -> {ValueSet,Rest5} = parse_ValueSet(Rest4), {#pvaluesetdef{pos=L1,name=Name,args=ParameterList, type=Type,valueset=ValueSet},Rest5}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'::=']}}) - end; -parse_ParameterizedValueSetTypeAssignment(Tokens) -> - throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - typereference]}}). + _ -> + parse_error(Rest3) + end. %% parse_ParameterizedObjectClassAssignment(Tokens) -> Result %% Result = {#ptypedef{},Rest} | throw() @@ -1864,18 +1561,13 @@ parse_ParameterizedObjectClassAssignment([{typereference,L1,Name}|Rest]) -> {Class,Rest4} = parse_ObjectClass(Rest3), {#ptypedef{pos=L1,name=Name,args=ParameterList,typespec=Class}, Rest4}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'::=']}}) - end; -parse_ParameterizedObjectClassAssignment(Tokens) -> - throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - typereference]}}). + _ -> + parse_error(Rest2) + end. %% parse_ParameterizedObjectAssignment(Tokens) -> Result %% Result = {#pobjectdef{},Rest} | throw() -parse_ParameterizedObjectAssignment([{identifier,L1,Name}|Rest]) -> +parse_ParameterizedObjectAssignment([#identifier{pos=L1,val=Name}|Rest]) -> {ParameterList,Rest2} = parse_ParameterList(Rest), {Class,Rest3} = parse_DefinedObjectClass(Rest2), case Rest3 of @@ -1883,36 +1575,9 @@ parse_ParameterizedObjectAssignment([{identifier,L1,Name}|Rest]) -> {Object,Rest5} = parse_Object(Rest4), {#pobjectdef{pos=L1,name=Name,args=ParameterList, class=Class,def=Object},Rest5}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'::=']}}) -%%% Other -> -%%% throw(Other) - end; -parse_ParameterizedObjectAssignment(Tokens) -> - throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,identifier]}}). - -%% parse_ParameterizedObjectSetAssignment(Tokens) -> Result -%% Result = {#pobjectsetdef{},Rest} | throw{} -parse_ParameterizedObjectSetAssignment([{typereference,L1,Name}|Rest]) -> - {ParameterList,Rest2} = parse_ParameterList(Rest), - {Class,Rest3} = parse_DefinedObjectClass(Rest2), - case Rest3 of - [{'::=',_}|Rest4] -> - {ObjectSet,Rest5} = parse_ObjectSet(Rest4), - {#pobjectsetdef{pos=L1,name=Name,args=ParameterList, - class=Class,def=ObjectSet},Rest5}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'::=']}}) -%%% Other -> -%%% throw(Other) - end; -parse_ParameterizedObjectSetAssignment(Tokens) -> - throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - typereference]}}). + _ -> + parse_error(Rest3) + end. %% parse_ParameterList(Tokens) -> Result %% Result = [Parameter] @@ -1921,22 +1586,18 @@ parse_ParameterizedObjectSetAssignment(Tokens) -> %% Type = #type{} %% DefinedObjectClass = #'Externaltypereference'{} %% Reference = #'Externaltypereference'{} | #'Externalvaluereference'{} -parse_ParameterList([{'{',_}|Rest]) -> - parse_ParameterList(Rest,[]); -parse_ParameterList(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'{']}}). +parse_ParameterList([{'{',_}|Tokens]) -> + parse_ParameterList(Tokens, []). parse_ParameterList(Tokens,Acc) -> {Parameter,Rest} = parse_Parameter(Tokens), case Rest of [{',',_}|Rest2] -> - parse_ParameterList(Rest2,[Parameter|Acc]); + parse_ParameterList(Rest2, [Parameter|Acc]); [{'}',_}|Rest3] -> - {lists:reverse([Parameter|Acc]),Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,[',','}']]}}) + {lists:reverse(Acc, [Parameter]),Rest3}; + _ -> + parse_error(Rest) end. parse_Parameter(Tokens) -> @@ -1950,9 +1611,8 @@ parse_ParamGovAndRef(Tokens) -> [{':',_}|Rest2] -> {Ref,Rest3} = parse_Reference(Rest2), {{ParamGov,Ref},Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,':']}}) + _ -> + parse_error(Rest) end. parse_ParamGovernor(Tokens) -> @@ -1960,69 +1620,45 @@ parse_ParamGovernor(Tokens) -> fun parse_Reference/1], parse_or(Tokens, Flist). -% parse_ParameterizedReference(Tokens) -> -% {Ref,Rest} = parse_Reference(Tokens), -% case Rest of -% [{'{',_},{'}',_}|Rest2] -> -% {{ptref,Ref},Rest2}; -% _ -> -% {{ptref,Ref},Rest} -% end. - parse_SimpleDefinedType([{typereference,L1,ModuleName},{'.',_}, {typereference,_,TypeName}|Rest]) -> {#'Externaltypereference'{pos=L1,module=ModuleName, type=TypeName},Rest}; parse_SimpleDefinedType([Tref={typereference,_,_}|Rest]) -> -% {#'Externaltypereference'{pos=L2,module=get(asn1_module), -% type=TypeName},Rest}; {tref2Exttref(Tref),Rest}; parse_SimpleDefinedType(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - [typereference,'typereference.typereference']]}}). + parse_error(Tokens). parse_SimpleDefinedValue([{typereference,L1,ModuleName},{'.',_}, - {identifier,_,Value}|Rest]) -> + #identifier{val=Value}|Rest]) -> {{simpledefinedvalue,#'Externalvaluereference'{pos=L1,module=ModuleName, value=Value}},Rest}; -parse_SimpleDefinedValue([Id={identifier,_,_Value}|Rest]) -> +parse_SimpleDefinedValue([#identifier{}=Id|Rest]) -> {{simpledefinedvalue,identifier2Extvalueref(Id)},Rest}; parse_SimpleDefinedValue(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - ['typereference.identifier',identifier]]}}). + parse_error(Tokens). parse_ParameterizedType(Tokens) -> + %% May also be a parameterized class. {Type,Rest} = parse_SimpleDefinedType(Tokens), {Params,Rest2} = parse_ActualParameterList(Rest), {#type{def={pt,Type,Params}},Rest2}. parse_ParameterizedValue(Tokens) -> + %% May also be a parameterized object. {Value,Rest} = parse_SimpleDefinedValue(Tokens), {Params,Rest2} = parse_ActualParameterList(Rest), {{pv,Value,Params},Rest2}. -parse_ParameterizedObjectClass(Tokens) -> - {Type,Rest} = parse_DefinedObjectClass(Tokens), - {Params,Rest2} = parse_ActualParameterList(Rest), - {{poc,Type,Params},Rest2}. - parse_ParameterizedObjectSet(Tokens) -> {ObjectSet,Rest} = parse_DefinedObjectSet(Tokens), {Params,Rest2} = parse_ActualParameterList(Rest), {{pos,ObjectSet,Params},Rest2}. -parse_ParameterizedObject(Tokens) -> - {Object,Rest} = parse_DefinedObject(Tokens), - {Params,Rest2} = parse_ActualParameterList(Rest), - {{po,Object,Params},Rest2}. - parse_ActualParameterList([{'{',_}|Rest]) -> parse_ActualParameterList(Rest,[]); parse_ActualParameterList(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'{']}}). + parse_error(Tokens). parse_ActualParameterList(Tokens,Acc) -> {Parameter,Rest} = parse_ActualParameter(Tokens), @@ -2030,43 +1666,22 @@ parse_ActualParameterList(Tokens,Acc) -> [{',',_}|Rest2] -> parse_ActualParameterList(Rest2,[Parameter|Acc]); [{'}',_}|Rest3] -> - {lists:reverse([Parameter|Acc]),Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,[',','}']]}}) -%%% Other -> -%%% throw(Other) + {lists:reverse(Acc, [Parameter]),Rest3}; + _ -> + parse_error(Rest) end. - - - - - - -%------------------------- - +%% Test whether Token is allowed in a syntax list. is_word(Token) -> - case not_allowed_word(Token) of + List = atom_to_list(Token), + case not_allowed_word(List) of true -> false; - _ -> - if - is_atom(Token) -> - Item = atom_to_list(Token), - is_word(Item); - is_list(Token), length(Token) == 1 -> - check_one_char_word(Token); - is_list(Token) -> - [A|Rest] = Token, - case check_first(A) of - true -> - check_rest(Rest); - _ -> - false - end - end + false -> is_word_1(List) end. +is_word_1([H|T]) -> + check_first(H) andalso check_rest(T). + not_allowed_word(Name) -> lists:member(Name,["BIT", "BOOLEAN", @@ -2091,255 +1706,123 @@ not_allowed_word(Name) -> "TRUE", "UNION"]). -check_one_char_word([A]) when $A =< A, $Z >= A -> - true; -check_one_char_word([_]) -> - false. %% unknown item in SyntaxList +check_first(C) -> + $A =< C andalso C =< $Z. -check_first(A) when $A =< A, $Z >= A -> - true; -check_first(_) -> - false. %% unknown item in SyntaxList - -check_rest([R,R|_Rs]) when $- == R -> - false; %% two consecutive hyphens are not allowed in a word -check_rest([R]) when $- == R -> - false; %% word cannot end with hyphen -check_rest([R|Rs]) when $A==R; $-==R -> +check_rest([R|Rs]) when $A =< R, R =< $Z; R =:= $- -> check_rest(Rs); check_rest([]) -> true; check_rest(_) -> false. -parse_AlternativeTypeLists(Tokens) -> - parse_AlternativeTypeLists(Tokens,[]). - -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} +%%% +%%% Parse alternative type lists for CHOICE. +%%% + +parse_AlternativeTypeLists(Tokens0) -> + {Root,Tokens1} = parse_AlternativeTypeList(Tokens0), + case Tokens1 of + [{',',_}|Tokens2] -> + {ExtMarker,Tokens3} = parse_ExtensionAndException(Tokens2), + {ExtAlts,Tokens4} = parse_ExtensionAdditionAlternatives(Tokens3), + {_,Tokens} = parse_OptionalExtensionMarker(Tokens4, []), + {Root++ExtMarker++ExtAlts,Tokens}; + Tokens -> + {Root,Tokens} end. +parse_ExtensionAndException([{'...',L}|Tokens0]) -> + {[#'EXTENSIONMARK'{pos=L}], + case Tokens0 of + [{'!',_}|Tokens1] -> + {_,Tokens} = parse_ExceptionIdentification(Tokens1), + Tokens; + _ -> + Tokens0 + end}. + +parse_AlternativeTypeList([#identifier{}|_]=Tokens0) -> + {AltType,Tokens} = parse_NamedType(Tokens0), + parse_AlternativeTypeList_1(Tokens, [AltType]); +parse_AlternativeTypeList(Tokens) -> + parse_error(Tokens). + +parse_AlternativeTypeList_1([{',',_}|[#identifier{}|_]=Tokens0], Acc) -> + {AltType,Tokens} = parse_NamedType(Tokens0), + parse_AlternativeTypeList_1(Tokens, [AltType|Acc]); +parse_AlternativeTypeList_1(Tokens, Acc) -> + {lists:reverse(Acc),Tokens}. +parse_ExtensionAdditionAlternatives([{',',_}|_]=Tokens0) -> + parse_ExtensionAdditionAlternativesList(Tokens0, []); +parse_ExtensionAdditionAlternatives(Tokens) -> + {[],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 - [{']',_},{']',_}|Rest2] -> - {[{'ExtensionAdditionGroup',Num}|CompTypeList] ++ - ['ExtensionAdditionGroupEnd'],Rest2}; +parse_ExtensionAdditionAlternativesList([{',',_}|Tokens1]=Tokens0, Acc) -> + try parse_ExtensionAdditionAlternative(Tokens1) of + {ExtAddAlt,Tokens2} -> + parse_ExtensionAdditionAlternativesList(Tokens2, [ExtAddAlt|Acc]) + catch + throw:{asn1_error,_} -> + {lists:append(lists:reverse(Acc)),Tokens0} + end; +parse_ExtensionAdditionAlternativesList(Tokens, Acc) -> + {lists:append(lists:reverse(Acc)),Tokens}. + +parse_ExtensionAdditionAlternative([#identifier{}|_]=Tokens0) -> + {NamedType,Tokens} = parse_NamedType(Tokens0), + {[NamedType],Tokens}; +parse_ExtensionAdditionAlternative([{'[',_},{'[',_}|Tokens0]) -> + Tokens2 = case Tokens0 of + [{number,_,_},{':',_}|Tokens1] -> Tokens1; + _ -> Tokens0 + end, + {GroupList,Tokens3} = parse_AlternativeTypeList(Tokens2), + case Tokens3 of + [{']',_},{']',_}|Tokens] -> + {GroupList,Tokens}; _ -> - 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_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_error(Tokens3) + end; +parse_ExtensionAdditionAlternative(Tokens) -> + parse_error(Tokens). - +%%% +%%% End of parsing of alternative type lists. +%%% -%% 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([{'[[',_}|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]) -> +parse_NamedType([#identifier{pos=L1,val=Idname}|Rest]) -> {Type,Rest2} = parse_Type(Rest), {#'ComponentType'{pos=L1,name=Idname,typespec=Type,prop=mandatory},Rest2}; parse_NamedType(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,identifier]}}). + parse_error(Tokens). +%%% +%%% Parse component type lists for SEQUENCE and SET. +%%% parse_ComponentTypeLists(Tokens) -> - parse_ComponentTypeLists(Tokens,[]). + parse_ComponentTypeLists(Tokens, []). -parse_ComponentTypeLists(Tokens = [{identifier,_,_}|_Rest0],Clist) -> +parse_ComponentTypeLists([#identifier{}|_Rest0]=Tokens, 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([{'COMPONENTS',_},{'OF',_}|_]=Tokens,Clist) -> + {CompList,Rest1} = parse_ComponentTypeList(Tokens, []), + parse_ComponentTypeLists(Rest1, Clist++CompList); 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_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_ComponentTypeLists(Tokens, _) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - identifier]}}). + parse_error(Tokens). parse_ComponentTypeLists2(Tokens,Clist) -> {ExtAdd,Rest} = parse_ExtensionAdditions(Tokens,Clist), @@ -2358,12 +1841,12 @@ parse_OptionalExtensionMarker(Tokens,Clist) -> {Clist,Tokens}. -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([{',',_}|[#identifier{}|_]=Tokens0], Acc) when Acc =/= [] -> + {ComponentType,Tokens} = parse_ComponentType(Tokens0), + parse_ComponentTypeList(Tokens, [ComponentType|Acc]); +parse_ComponentTypeList([{',',_}|[{'COMPONENTS',_},{'OF',_}|_]=Tokens0], Acc) when Acc =/= [] -> + {ComponentType,Tokens} = parse_ComponentType(Tokens0), + parse_ComponentTypeList(Tokens, [ComponentType|Acc]); parse_ComponentTypeList(Tokens = [{'}',_}|_],Acc) -> {lists:reverse(Acc),Tokens}; parse_ComponentTypeList(Tokens = [{']',_},{']',_}|_],Acc) -> @@ -2374,10 +1857,7 @@ 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_error(Tokens). parse_ExtensionAdditions(Tokens=[{',',_}|_],Clist) -> {ExtAddList,Rest2} = parse_ExtensionAdditionList(Tokens,[]), @@ -2386,46 +1866,36 @@ 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([{',',_}|[#identifier{}|_]=Tokens0], Acc) -> + {ComponentType,Tokens} = parse_ComponentType(Tokens0), + parse_ExtensionAdditionList(Tokens, [ComponentType|Acc]); +parse_ExtensionAdditionList([{',',_}|[{'COMPONENTS',_},{'OF',_}|_]=Tokens0], Acc) -> + {ComponentType,Tokens} = parse_ComponentType(Tokens0), + parse_ExtensionAdditionList(Tokens, [ComponentType|Acc]); +parse_ExtensionAdditionList([{',',_},{'[',_},{'[',_}|Tokens], Acc) -> + {ExtAddGroup,Rest2} = parse_ExtensionAdditionGroup(Tokens), parse_ExtensionAdditionList(Rest2,[ExtAddGroup|Acc]); -parse_ExtensionAdditionList(Tokens = [{'}',_}|_],Acc) -> +parse_ExtensionAdditionList([{'}',_}|_]=Tokens, Acc) -> {lists:reverse(Acc),Tokens}; -parse_ExtensionAdditionList(Tokens = [{',',_},{'...',_}|_],Acc) -> +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_ExtensionAdditionList(Tokens, _) -> + parse_error(Tokens). -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_ExtensionAdditionGroup([{number,_,Num},{':',_}|Tokens]) -> + parse_ExtensionAdditionGroup2(Tokens, Num); +parse_ExtensionAdditionGroup(Tokens) -> + parse_ExtensionAdditionGroup2(Tokens, undefined). -parse_ExtensionAdditionGroup2(Tokens,Num) -> +parse_ExtensionAdditionGroup2(Tokens, Num) -> {CompTypeList,Rest} = parse_ComponentTypeList(Tokens,[]), case Rest of [{']',_},{']',_}|Rest2] -> {[{'ExtensionAdditionGroup',Num}|CompTypeList] ++ ['ExtensionAdditionGroupEnd'],Rest2}; _ -> - throw({asn1_error,{get_line(hd(Rest)),get(asn1_module), - [got,get_token(hd(Rest)),expected,[']]']]}}) + parse_error(Rest) end. @@ -2444,79 +1914,81 @@ parse_ComponentType(Tokens) -> Result end. - - -parse_SignedNumber([{number,_,Value}|Rest]) -> - {Value,Rest}; -parse_SignedNumber([{'-',_},{number,_,Value}|Rest]) -> - {-Value,Rest}; -parse_SignedNumber(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - [number,'-number']]}}). - -parse_Enumerations(Tokens=[{identifier,_,_}|_Rest],ExtensionDefault) -> - parse_Enumerations(Tokens,[],ExtensionDefault); -parse_Enumerations([H|_T],_) -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,identifier]}}). - -parse_Enumerations(Tokens = [{identifier,_,_},{'(',_}|_Rest], Acc, ExtensionDefault) -> - {NamedNumber,Rest2} = parse_NamedNumber(Tokens), - case Rest2 of - [{',',_}|Rest3] -> - parse_Enumerations(Rest3,[NamedNumber|Acc], ExtensionDefault); - _ when ExtensionDefault == 'IMPLIED'-> - {lists:reverse(['EXTENSIONMARK',NamedNumber|Acc]),Rest2}; - _ -> - {lists:reverse([NamedNumber|Acc]),Rest2} - end; -parse_Enumerations([{identifier,_,Id}|Rest], Acc, ExtensionDefault) -> - case Rest of - [{',',_}|Rest2] -> - parse_Enumerations(Rest2,[Id|Acc], ExtensionDefault); - _ when ExtensionDefault == 'IMPLIED' -> - {lists:reverse(['EXTENSIONMARK', Id |Acc]),Rest}; +%%% +%%% Parse ENUMERATED. +%%% + +parse_Enumerations(Tokens0) -> + {Root,Tokens1} = parse_Enumeration(Tokens0), + case Tokens1 of + [{',',_},{'...',_},{',',_}|Tokens2] -> + {Ext,Tokens} = parse_Enumeration(Tokens2), + {Root++['EXTENSIONMARK'|Ext],Tokens}; + [{',',_},{'...',_}|Tokens] -> + {Root++['EXTENSIONMARK'],Tokens}; _ -> - {lists:reverse([Id|Acc]),Rest} - end; -parse_Enumerations([{'...',_}|Rest], Acc, _ExtensionDefault) -> - case Rest of - [{',',_}|Rest2] -> - parse_Enumerations(Rest2,['EXTENSIONMARK'|Acc],undefined); - _ -> - {lists:reverse(['EXTENSIONMARK'|Acc]),Rest} + case get(extensiondefault) of + 'IMPLIED' -> + {Root++['EXTENSIONMARK'],Tokens1}; + _ -> + {Root,Tokens1} + end + end. + +parse_Enumeration(Tokens0) -> + {Item,Tokens} = parse_EnumerationItem(Tokens0), + parse_Enumeration_1(Tokens, [Item]). + +parse_Enumeration_1([{',',_}|Tokens1]=Tokens0, Acc) -> + try parse_EnumerationItem(Tokens1) of + {Item,Tokens} -> + parse_Enumeration_1(Tokens, [Item|Acc]) + catch + throw:{asn1_error,_} -> + {lists:reverse(Acc),Tokens0} end; -parse_Enumerations([H|_T],_,_) -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,identifier]}}). +parse_Enumeration_1(Tokens, Acc) -> + {lists:reverse(Acc),Tokens}. + +parse_EnumerationItem([#identifier{},{'(',_}|_]=Tokens) -> + parse_NamedNumber(Tokens); +parse_EnumerationItem([#identifier{val=Id}|Tokens]) -> + {Id,Tokens}; +parse_EnumerationItem(Tokens) -> + parse_error(Tokens). + +%%% +%%% End of parsing of ENUMERATED. +%%% parse_NamedNumberList(Tokens) -> - parse_NamedNumberList(Tokens,[]). + parse_NamedNumberList(Tokens, []). -parse_NamedNumberList(Tokens,Acc) -> +parse_NamedNumberList(Tokens, Acc) -> {NamedNum,Rest} = parse_NamedNumber(Tokens), case Rest of [{',',_}|Rest2] -> parse_NamedNumberList(Rest2,[NamedNum|Acc]); _ -> - {lists:reverse([NamedNum|Acc]),Rest} + {lists:reverse(Acc, [NamedNum]),Rest} end. -parse_NamedNumber([{identifier,_,Name},{'(',_}|Rest]) -> +parse_NamedNumber([#identifier{val=Name},{'(',_}|Rest]) -> Flist = [fun parse_SignedNumber/1, fun parse_DefinedValue/1], case parse_or(Rest, Flist) of {NamedNum,[{')',_}|Rest2]} -> {{'NamedNumber',Name,NamedNum},Rest2}; _ -> - throw({asn1_error,{get_line(hd(Rest)),get(asn1_module), - [got,get_token(hd(Rest)),expected,'NamedNumberList']}}) + parse_error(Rest) end; parse_NamedNumber(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,identifier]}}). + parse_error(Tokens). +parse_SignedNumber([{number,_,Value}|Rest]) -> + {Value,Rest}; +parse_SignedNumber(Tokens) -> + parse_error(Tokens). parse_Tag([{'[',_}|Rest]) -> {Class,Rest2} = parse_Class(Rest), @@ -2531,12 +2003,8 @@ parse_Tag([{'[',_}|Rest]) -> [{']',_}|Rest4] -> {#tag{class=Class,number=ClassNumber},Rest4}; _ -> - throw({asn1_error,{get_line(hd(Rest3)),get(asn1_module), - [got,get_token(hd(Rest3)),expected,']']}}) - end; -parse_Tag(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'[']}}). + parse_error(Rest3) + end. parse_Class([{'UNIVERSAL',_}|Rest]) -> {'UNIVERSAL',Rest}; @@ -2569,10 +2037,10 @@ parse_BuiltinValue(Tokens = [{'{',_}|_Rest]) -> fun parse_SequenceValue/1, fun parse_ObjectIdentifierValue/1], parse_or(Tokens, Flist); -parse_BuiltinValue([{identifier,_,IdName},{':',_}|Rest]) -> +parse_BuiltinValue([#identifier{val=IdName},{':',_}|Rest]) -> {Value,Rest2} = parse_Value(Rest), {{'CHOICE',{IdName,Value}},Rest2}; -parse_BuiltinValue(Tokens=[{'NULL',_},{':',_}|_Rest]) -> +parse_BuiltinValue([{'NULL',_},{':',_}|_]=Tokens) -> parse_ObjectClassFieldValue(Tokens); parse_BuiltinValue([{'NULL',_}|Rest]) -> {'NULL',Rest}; @@ -2588,31 +2056,29 @@ parse_BuiltinValue([{cstring,_,Cstr}|Rest]) -> {Cstr,Rest}; parse_BuiltinValue([{number,_,Num}|Rest]) -> {Num,Rest}; -parse_BuiltinValue([{'-',_},{number,_,Num}|Rest]) -> - {- Num,Rest}; parse_BuiltinValue(Tokens) -> parse_ObjectClassFieldValue(Tokens). -parse_DefinedValue(Tokens=[{identifier,_,_},{'{',_}|_Rest]) -> - parse_ParameterizedValue(Tokens); -%% Externalvaluereference -parse_DefinedValue([{typereference,L1,Tname},{'.',_},{identifier,_,Idname}|Rest]) -> +parse_DefinedValue(Tokens) -> + Flist = [fun parse_ParameterizedValue/1, + fun parse_DefinedValue2/1], + parse_or(Tokens, Flist). + +parse_DefinedValue2([{typereference,L1,Tname}, + {'.',_}, + #identifier{val=Idname}|Rest]) -> {#'Externalvaluereference'{pos=L1,module=Tname,value=Idname},Rest}; %% valuereference -parse_DefinedValue([Id = {identifier,_,_}|Rest]) -> +parse_DefinedValue2([#identifier{}=Id|Rest]) -> {identifier2Extvalueref(Id),Rest}; -%% ParameterizedValue -parse_DefinedValue(Tokens) -> - parse_ParameterizedValue(Tokens). +parse_DefinedValue2(Tokens) -> + parse_error(Tokens). parse_SequenceValue([{'{',_}|Tokens]) -> - parse_SequenceValue(Tokens,[]); -parse_SequenceValue(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'{']}}). + parse_SequenceValue(Tokens, []). -parse_SequenceValue([{identifier,Pos,IdName}|Rest],Acc) -> +parse_SequenceValue([#identifier{pos=Pos,val=IdName}|Rest],Acc) -> {Value,Rest2} = parse_Value(Rest), SeqTag = #seqtag{pos=Pos,module=get(asn1_module),val=IdName}, case Rest2 of @@ -2621,18 +2087,13 @@ parse_SequenceValue([{identifier,Pos,IdName}|Rest],Acc) -> [{'}',_}|Rest3] -> {lists:reverse(Acc, [{SeqTag,Value}]),Rest3}; _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'}']}}) + parse_error(Rest2) end; parse_SequenceValue(Tokens,_Acc) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,identifier]}}). + parse_error(Tokens). parse_SequenceOfValue([{'{',_}|Tokens]) -> - parse_SequenceOfValue(Tokens,[]); -parse_SequenceOfValue(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'{']}}). + parse_SequenceOfValue(Tokens, []). parse_SequenceOfValue(Tokens,Acc) -> {Value,Rest2} = parse_Value(Tokens), @@ -2640,10 +2101,9 @@ parse_SequenceOfValue(Tokens,Acc) -> [{',',_}|Rest3] -> parse_SequenceOfValue(Rest3,[Value|Acc]); [{'}',_}|Rest3] -> - {lists:reverse([Value|Acc]),Rest3}; + {lists:reverse(Acc, [Value]),Rest3}; _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'}']}}) + parse_error(Rest2) end. parse_ValueSetTypeAssignment([{typereference,L1,Name}|Rest]) -> @@ -2653,29 +2113,22 @@ parse_ValueSetTypeAssignment([{typereference,L1,Name}|Rest]) -> {ValueSet,Rest4} = parse_ValueSet(Rest3), {#valuedef{pos=L1,name=Name,type=Type,value=ValueSet, module=get(asn1_module)},Rest4}; - [H|_T] -> - throw({asn1_error,{get_line(L1),get(asn1_module), - [got,get_token(H),expected,'::=']}}) - end; -parse_ValueSetTypeAssignment(Tokens) -> - throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected, - typereference]}}). + _ -> + parse_error(Rest2) + end. parse_ValueSet([{'{',_}|Rest]) -> {Elems,Rest2} = parse_ElementSetSpecs(Rest), case Rest2 of [{'}',_}|Rest3] -> {{valueset,Elems},Rest3}; - [H|_T] -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'}']}}) + _ -> + parse_error(Rest2) end; parse_ValueSet(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'{']}}). + parse_error(Tokens). -parse_ValueAssignment([{identifier,L1,IdName}|Rest]) -> +parse_ValueAssignment([#identifier{pos=L1,val=IdName}|Rest]) -> {Type,Rest2} = parse_Type(Rest), case Rest2 of [{'::=',_}|Rest3] -> @@ -2684,12 +2137,8 @@ parse_ValueAssignment([{identifier,L1,IdName}|Rest]) -> {#valuedef{pos=L1,name=IdName,type=Type,value=Value, module=get(asn1_module)},Rest4}; _ -> - throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module), - [got,get_token(hd(Rest2)),expected,'::=']}}) - end; -parse_ValueAssignment(Tokens) -> - throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,identifier]}}). + parse_error(Rest2) + end. %% SizeConstraint parse_SubtypeElements([{'SIZE',_}|Tokens]) -> @@ -2709,8 +2158,7 @@ parse_SubtypeElements([{'WITH',_},{'COMPONENTS',_},{'{',_},{'...',_},{',',_}|Tok [{'}',_}|Rest2] -> {{'WITH COMPONENTS',{'PartialSpecification',Constraint}},Rest2}; _ -> - throw({asn1_error,{get_line(hd(Rest)),get(asn1_module), - [got,get_token(hd(Rest)),expected,'}']}}) + parse_error(Rest) end; parse_SubtypeElements([{'WITH',_},{'COMPONENTS',_},{'{',_}|Tokens]) -> {Constraint,Rest} = parse_TypeConstraints(Tokens), @@ -2718,17 +2166,11 @@ parse_SubtypeElements([{'WITH',_},{'COMPONENTS',_},{'{',_}|Tokens]) -> [{'}',_}|Rest2] -> {{'WITH COMPONENTS',{'FullSpecification',Constraint}},Rest2}; _ -> - throw({asn1_error,{get_line(hd(Rest)),get(asn1_module), - [got,get_token(hd(Rest)),expected,'}']}}) + parse_error(Rest) end; parse_SubtypeElements([{'PATTERN',_}|Tokens]) -> {Value,Rest} = parse_Value(Tokens), {{pattern,Value},Rest}; -%% SingleValue -%% ContainedSubtype -%% ValueRange -%% TypeConstraint -%% Moved fun parse_Value/1 and fun parse_Type/1 to parse_Elements parse_SubtypeElements(Tokens) -> Flist = [fun parse_ContainedSubtype/1, fun parse_Value/1, @@ -2753,10 +2195,7 @@ parse_ContainedSubtype([{'INCLUDES',_}|Rest]) -> {Type,Rest2} = parse_Type(Rest), {{'ContainedSubtype',Type},Rest2}; parse_ContainedSubtype(Tokens) -> - throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module), - [got,get_token(hd(Tokens)),expected,'INCLUDES']}}). -%%parse_ContainedSubtype(Tokens) -> %this option is moved to parse_SubtypeElements -%% parse_Type(Tokens). + parse_error(Tokens). parse_UpperEndpoint([{'<',_}|Rest]) -> parse_UpperEndpoint(lt,Rest); @@ -2775,30 +2214,27 @@ parse_UpperEndpoint(Lt,Tokens) -> parse_MIN([{'MIN',_}|T]) -> {'MIN',T}; -parse_MIN([H|_]) -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'MIN']}}). +parse_MIN(Tokens) -> + parse_error(Tokens). parse_MAX([{'MAX',_}|T]) -> {'MAX',T}; -parse_MAX([H|_]) -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,'MAX']}}). +parse_MAX(Tokens) -> + parse_error(Tokens). parse_TypeConstraints(Tokens) -> - parse_TypeConstraints(Tokens,[]). + parse_TypeConstraints(Tokens, []). -parse_TypeConstraints([{identifier,_,_}|Rest],Acc) -> +parse_TypeConstraints([#identifier{}|Rest], Acc) -> {ComponentConstraint,Rest2} = parse_ComponentConstraint(Rest), case Rest2 of [{',',_}|Rest3] -> - parse_TypeConstraints(Rest3,[ComponentConstraint|Acc]); + parse_TypeConstraints(Rest3, [ComponentConstraint|Acc]); _ -> - {lists:reverse([ComponentConstraint|Acc]),Rest2} + {lists:reverse(Acc, [ComponentConstraint]),Rest2} end; -parse_TypeConstraints([H|_T],_) -> - throw({asn1_error,{get_line(H),get(asn1_module), - [got,get_token(H),expected,identifier]}}). +parse_TypeConstraints(Tokens, _) -> + parse_error(Tokens). parse_ComponentConstraint(Tokens = [{'(',_}|_Rest]) -> {ValueConstraint,Rest2} = parse_Constraint(Tokens), @@ -2836,56 +2272,18 @@ merge_constraints([], Cacc, Eacc) -> get_line({Token,Pos,_}) when is_integer(Pos), is_atom(Token) -> Pos; get_line({Token,Pos}) when is_integer(Pos),is_atom(Token) -> - Pos; -get_line(_) -> - undefined. - -get_token({_,Pos,Token}) when is_integer(Pos),is_atom(Token) -> - Token; + Pos. + +get_token({valuefieldreference,_,FieldName}) -> + list_to_atom([$&|atom_to_list(FieldName)]); +get_token({typefieldreference,_,FieldName}) -> + list_to_atom([$&|atom_to_list(FieldName)]); +get_token({Token,Pos,Value}) when is_integer(Pos), is_atom(Token) -> + Value; get_token({'$end',Pos}) when is_integer(Pos) -> - undefined; + 'END-OF-FILE'; get_token({Token,Pos}) when is_integer(Pos),is_atom(Token) -> - Token; -get_token(_) -> - undefined. - -%% Choose the "best" error: -%% 1) the error with the highest line number, -%% 2) the last error which is not an asn1_assignment_error, or -%% 3) the last error. -prioritize_error([_|_]=ErrList) -> - case lists:keymember(asn1_error,1,ErrList) of - false -> % only asn1_assignment_error -> take the last - lists:last(ErrList); - true -> % contains errors from deeper in a Type - NewErrList = [_Err={_,_}|_RestErr] = - lists:filter(fun({asn1_error,_})->true;(_)->false end, - ErrList), - SplitErrs = - lists:splitwith(fun({_,X})-> - case element(1,X) of - Int when is_integer(Int) -> true; - _ -> false - end - end, - NewErrList), - case SplitErrs of - {[],UndefPosErrs} -> % if no error with Positon exists - lists:last(UndefPosErrs); - {IntPosErrs,_} -> - IntPosReasons = lists:map(fun(X)->element(2,X) end,IntPosErrs), - SortedReasons = lists:keysort(1,IntPosReasons), - {asn1_error,lists:last(SortedReasons)} - end - end. - -%% most_prio_error([H={_,Reason}|T],Atom,Err) when is_atom(Atom) -> -%% most_prio_error(T,element(1,Reason),H); -%% most_prio_error([H={_,Reason}|T],Greatest,Err) -> -%% case element(1,Reason) of -%% Pos when is_integer(Pos),Pos>Greatest -> -%% most_prio_error( - + Token. tref2Exttref(#typereference{pos=Pos,val=Name}) -> #'Externaltypereference'{pos=Pos, @@ -2910,3 +2308,6 @@ lookahead_assignment([{'END',_}|_Rest]) -> lookahead_assignment(Tokens) -> {_,_} = parse_Assignment(Tokens), ok. + +parse_error(Tokens) -> + throw({asn1_error,{parse_error,Tokens}}). -- cgit v1.2.3 From e96b4bbb802cd00fa14deb12d7200873c7a79e85 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 5 Dec 2014 07:48:26 +0100 Subject: asn1ct_parser2: Remove expensive lookahead_assignment/1 function In the parsing of a value assignment, such as: value INTEGER ::= 42 there is call to a function called lookahead_assignment/1 that will ensure that the sequence of tokens that follows the value is a valid assignment. The problem is that if the next assignment is a value assignment, that too will look ahead to the next assignment. That means that the complexity will be quadratic if there are many value assignments following each other. The reason for the test in the first place is unclear; my guess is that it was an attempt to provide better error reporting. --- lib/asn1/src/asn1ct_parser2.erl | 10 ---------- 1 file changed, 10 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl index 7a1c7230b3..488e4af4e0 100644 --- a/lib/asn1/src/asn1ct_parser2.erl +++ b/lib/asn1/src/asn1ct_parser2.erl @@ -2133,7 +2133,6 @@ parse_ValueAssignment([#identifier{pos=L1,val=IdName}|Rest]) -> case Rest2 of [{'::=',_}|Rest3] -> {Value,Rest4} = parse_Value(Rest3), - lookahead_assignment(Rest4), {#valuedef{pos=L1,name=IdName,type=Type,value=Value, module=get(asn1_module)},Rest4}; _ -> @@ -2300,14 +2299,5 @@ identifier2Extvalueref(#identifier{pos=Pos,val=Name}) -> module=resolve_module(Name), value=Name}. -%% lookahead_assignment/1 checks that the next sequence of tokens -%% in Token contain a valid assignment or the -%% 'END' token. Otherwise an exception is thrown. -lookahead_assignment([{'END',_}|_Rest]) -> - ok; -lookahead_assignment(Tokens) -> - {_,_} = parse_Assignment(Tokens), - ok. - parse_error(Tokens) -> throw({asn1_error,{parse_error,Tokens}}). -- cgit v1.2.3 From b320ccf10becb894c2b325da69a65b316189b4a6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 11 Dec 2014 14:51:56 +0100 Subject: asn1ct_tok: Clean up --- lib/asn1/src/asn1ct_tok.erl | 332 ++++++++++++++++++++------------------------ 1 file changed, 152 insertions(+), 180 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_tok.erl b/lib/asn1/src/asn1ct_tok.erl index 8687ed955c..d51fea6402 100644 --- a/lib/asn1/src/asn1ct_tok.erl +++ b/lib/asn1/src/asn1ct_tok.erl @@ -21,191 +21,177 @@ %% Tokenize ASN.1 code (input to parser generated with yecc) --export([get_name/2,tokenise/4, file/1]). +-export([file/1,format_error/1]). - -file(File) -> - case file:open(File, [read]) of +file(File0) -> + case file:open(File0, [read]) of {error, Reason} -> - {error,{File,file:format_error(Reason)}}; + {error,{File0,file:format_error(Reason)}}; {ok,Stream} -> - process(Stream,0,[]) + try + process(Stream, 1, []) + catch + throw:{error,Line,Reason} -> + File = filename:basename(File0), + Error = {structured_error,{File,Line},?MODULE,Reason}, + {error,[Error]} + end end. -process(Stream,Lno,R) -> - process(io:get_line(Stream, ''), Stream,Lno+1,R). +process(Stream, Lno, R) -> + process(io:get_line(Stream, ''), Stream, Lno, R). -process(eof, Stream,Lno,R) -> +process(eof, Stream, Lno, Acc) -> ok = file:close(Stream), - lists:flatten(lists:reverse([{'$end',Lno}|R])); - - -process(L, Stream,Lno,R) when is_list(L) -> - %%io:format('read:~s',[L]), - case catch tokenise(Stream,L,Lno,[]) of - {'ERR',Reason} -> - io:format("Tokeniser error on line: ~w ~w~n",[Lno,Reason]), - exit(0); - {NewLno,T} -> - %%io:format('toks:~w~n',[T]), - process(Stream,NewLno,[T|R]) - end. - -tokenise(Stream,[H|T],Lno,R) when $a =< H , H =< $z -> - {X, T1} = get_name(T, [H]), - tokenise(Stream,T1,Lno,[{identifier,Lno, list_to_atom(X)}|R]); - -tokenise(Stream,[$&,H|T],Lno,R) when $A =< H , H =< $Z -> - {Y, T1} = get_name(T, [H]), - X = list_to_atom(Y), - tokenise(Stream,T1,Lno,[{typefieldreference, Lno, X} | R]); - -tokenise(Stream,[$&,H|T],Lno,R) when $a =< H , H =< $z -> - {Y, T1} = get_name(T, [H]), - X = list_to_atom(Y), - tokenise(Stream,T1,Lno,[{valuefieldreference, Lno, X} | R]); - -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 -> - tokenise(Stream,T1,Lno,[{X,Lno}|R]); - false -> - tokenise(Stream,T1,Lno,[{typereference,Lno,X}|R]); - rstrtype -> - tokenise(Stream,T1,Lno,[{restrictedcharacterstringtype,Lno,X}|R]) - end; - -tokenise(Stream,[$-,H|T],Lno,R) when $0 =< H , H =< $9 -> - {X, T1} = get_number(T, [H]), - tokenise(Stream,T1,Lno,[{number,Lno,-1 * list_to_integer(X)}|R]); + lists:reverse([{'$end',Lno}|Acc]); +process(L, Stream, Lno0, Acc) when is_list(L) -> + try tokenise(Stream, L, Lno0, []) of + {Lno,[]} -> + process(Stream, Lno, Acc); + {Lno,Ts} -> + process(Stream, Lno, Ts++Acc) + catch + throw:{error,Reason} -> + throw({error,Lno0,Reason}) + end. -tokenise(Stream,[H|T],Lno,R) when $0 =< H , H =< $9 -> +format_error(eof_in_comment) -> + "premature end of file in multi-line comment"; +format_error(eol_in_token) -> + "end of line in token"; +format_error({invalid_binary_number,Str}) -> + io_lib:format("invalid binary number: '~s'", [Str]); +format_error({invalid_hex_number,Str}) -> + io_lib:format("invalid hex number: '~s'", [Str]); +format_error(Other) -> + io_lib:format("~p", [Other]). + +tokenise(Stream, [$&,H|T], Lno, R) when $A =< H , H =< $Z -> + {X,T1} = get_name(T, [H]), + tokenise(Stream, T1, Lno, [{typefieldreference,Lno,X}|R]); +tokenise(Stream, [$&,H|T], Lno, R) when $a =< H , H =< $z -> + {X,T1} = get_name(T, [H]), + tokenise(Stream, T1, Lno, [{valuefieldreference,Lno,X}|R]); + +tokenise(Stream, "--"++T, Lno, R) -> + tokenise(Stream, skip_comment(T), Lno, R); + +tokenise(Stream, [$-,H|T], Lno, R) when $0 =< H , H =< $9 -> {X, T1} = get_number(T, [H]), - tokenise(Stream,T1,Lno,[{number,Lno,list_to_integer(X)}|R]); - -tokenise(Stream,[$-,$-|T],Lno,R) -> - tokenise(Stream,skip_comment(T),Lno,R); + tokenise(Stream, T1, Lno, [{number,Lno,-list_to_integer(X)}|R]); -tokenise(Stream,[$/,$*|T],Lno,R) -> - {NewLno,T1} = skip_multiline_comment(Stream,T,Lno,0), - tokenise(Stream,T1,NewLno,R); +tokenise(Stream, "/*"++T, Lno0, R) -> + {Lno,T1} = skip_multiline_comment(Stream, T, Lno0, 0), + tokenise(Stream, T1, Lno, R); -tokenise(Stream,[$:,$:,$=|T],Lno,R) -> - tokenise(Stream,T,Lno,[{'::=',Lno}|R]); - -tokenise(Stream,[$'|T],Lno,R) -> - case catch collect_quoted(T,Lno,[]) of - {'ERR',_} -> - throw({'ERR','bad_quote'}); - {Thing, T1} -> - tokenise(Stream,T1,Lno,[Thing|R]) - end; +tokenise(Stream, "::="++T, Lno, R) -> + tokenise(Stream, T, Lno, [{'::=',Lno}|R]); +tokenise(Stream, ":"++T, Lno, R) -> + tokenise(Stream, T, Lno, [{':',Lno}|R]); +tokenise(Stream, "'"++T0, Lno, R) -> + {Thing, T1} = collect_quoted(T0, Lno, []), + tokenise(Stream, T1, Lno, [Thing|R]); 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(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]); %% 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 +%% it does not work to have them as such since the single '[' and ']' can +%% be used beside each other in 'WITH SYNTAX' 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(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]); +%% which would be an error in the use in ExtensionAdditionGroups. -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(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(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(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,[H|T],Lno,R) -> - case white_space(H) of +tokenise(Stream, [H|T], Lno, R) when $A =< H , H =< $Z -> + {X,T1} = get_name(T, [H]), + case reserved_word(X) of true -> - tokenise(Stream,T,Lno,R); + tokenise(Stream, T1, Lno, [{X,Lno}|R]); false -> - tokenise(Stream,T,Lno,[{list_to_atom([H]),Lno}|R]) + tokenise(Stream, T1, Lno, [{typereference,Lno,X}|R]); + rstrtype -> + tokenise(Stream, T1, Lno, [{restrictedcharacterstringtype,Lno,X}|R]) end; -tokenise(_Stream,[],Lno,R) -> - {Lno,lists:reverse(R)}. +tokenise(Stream, [H|T], Lno, R) when $a =< H , H =< $z -> + {X, T1} = get_name(T, [H]), + tokenise(Stream, T1, Lno, [{identifier,Lno,X}|R]); -collect_string(L,Lno) -> - collect_string(L,Lno,[]). +tokenise(Stream, [H|T], Lno, R) when $0 =< H , H =< $9 -> + {X, T1} = get_number(T, [H]), + tokenise(Stream, T1, Lno, [{number,Lno,list_to_integer(X)}|R]); -collect_string([],_,_) -> - throw({'ERR','bad_quote found eof'}); +tokenise(Stream, [H|T], Lno, R) when H =< $\s -> + tokenise(Stream, T, Lno, R); -collect_string([H|T],Lno,Str) -> - case H of - $" -> - {{cstring,1,lists:reverse(Str)},T}; - Ch -> - collect_string(T,Lno,[Ch|Str]) - end. - +tokenise(Stream, [H|T], Lno, R) -> + tokenise(Stream, T, Lno, [{list_to_atom([H]),Lno}|R]); +tokenise(_Stream, [], Lno, R) -> + {Lno+1,R}. -% is letters digits hyphens -% hypen is not the last character. Hypen hyphen is NOT allowed -% -% ::= +collect_string(L, Lno) -> + collect_string(L, Lno, []). -get_name([$-,Char|T], L) -> +collect_string([$"|T], _Lno, Str) -> + {{cstring,1,lists:reverse(Str)},T}; +collect_string([H|T], Lno, Str) -> + collect_string(T, Lno, [H|Str]); +collect_string([], _, _) -> + throw({error,missing_quote_at_eof}). + +%% is letters digits hyphens. +%% Hypen is not the last character. Hypen hyphen is NOT allowed. +%% +%% ::= + +get_name([$-,Char|T]=T0, Acc) -> case isalnum(Char) of true -> - get_name(T,[Char,$-|L]); + get_name(T, [Char,$-|Acc]); false -> - {lists:reverse(L),[$-,Char|T]} + {list_to_atom(lists:reverse(Acc)),T0} end; -get_name([$-|T], L) -> - {lists:reverse(L),[$-|T]}; -get_name([Char|T], L) -> +get_name([$-|_]=T, Acc) -> + {list_to_atom(lists:reverse(Acc)),T}; +get_name([Char|T]=T0, Acc) -> case isalnum(Char) of true -> - get_name(T,[Char|L]); + get_name(T, [Char|Acc]); false -> - {lists:reverse(L),[Char|T]} + {list_to_atom(lists:reverse(Acc)),T0} end; -get_name([], L) -> - {lists:reverse(L), []}. - +get_name([], Acc) -> + {list_to_atom(lists:reverse(Acc)),[]}. isalnum(H) when $A =< H , H =< $Z -> true; @@ -221,67 +207,54 @@ isdigit(H) when $0 =< H , H =< $9 -> isdigit(_) -> false. -white_space(9) -> true; -white_space(10) -> true; -white_space(13) -> true; -white_space(32) -> true; -white_space(_) -> false. - - -get_number([H|T], L) -> +get_number([H|T]=T0, L) -> case isdigit(H) of true -> get_number(T, [H|L]); false -> - {lists:reverse(L), [H|T]} + {lists:reverse(L), T0} end; get_number([], L) -> {lists:reverse(L), []}. -skip_comment([]) -> - []; -skip_comment([$-,$-|T]) -> - T; -skip_comment([_|T]) -> - skip_comment(T). - +skip_comment([]) -> []; +skip_comment("--"++T) -> T; +skip_comment([_|T]) -> skip_comment(T). -skip_multiline_comment(Stream,[],Lno,Level) -> - case io:get_line(Stream,'') of +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); + throw({error,eof_in_comment}); Line -> - skip_multiline_comment(Stream,Line,Lno+1,Level) + skip_multiline_comment(Stream, Line, Lno+1, Level) end; -skip_multiline_comment(_Stream,[$*,$/|T],Lno,0) -> +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) -> +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 true -> - {{bstring,Lno, lists:reverse(L)}, T}; + {{bstring,Lno,lists:reverse(L)}, T}; false -> - throw({'ERR',{invalid_binary_number, lists:reverse(L)}}) + throw({error,{invalid_binary_number,lists:reverse(L)}}) end; -collect_quoted([$',$H|T],Lno, L) -> +collect_quoted("'H"++T, Lno, L) -> case check_hex(L) of true -> - {{hstring,Lno, lists:reverse(L)}, T}; + {{hstring,Lno,lists:reverse(L)}, T}; false -> - throw({'ERR',{invalid_binary_number, lists:reverse(L)}}) + throw({error,{invalid_hex_number,lists:reverse(L)}}) end; collect_quoted([H|T], Lno, L) -> collect_quoted(T, Lno,[H|L]); collect_quoted([], _, _) -> % This should be allowed FIX later - throw({'ERR',{eol_in_token}}). + throw({error,eol_in_token}). check_bin([$0|T]) -> check_bin(T); @@ -351,7 +324,6 @@ reserved_word('INCLUDES') -> true; reserved_word('INSTANCE') -> true; reserved_word('INTEGER') -> true; reserved_word('INTERSECTION') -> true; -reserved_word('ISO646String') -> rstrtype; reserved_word('MAX') -> true; reserved_word('MIN') -> true; reserved_word('MINUS-INFINITY') -> true; -- cgit v1.2.3 From e38bb8064a13679fb42c12fd2ec26268d24ddb41 Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Thu, 4 Dec 2014 16:29:09 +0100 Subject: Further improve error handling for instatiation of parameterized types --- lib/asn1/src/asn1ct_check.erl | 35 ++++++++++++++++------------------- 1 file changed, 16 insertions(+), 19 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 23794f789a..0f73f21582 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -1183,19 +1183,13 @@ instantiate_po(S=#state{parameters=_OldArgs},_ClassDef,Object,ArgsList) when is_ %% on the right side of the assignment, %% ArgsList is the list of actual parameters, i.e. real objects instantiate_pos(S=#state{parameters=_OldArgs},ClassRef,ObjectSetDef,ArgsList) -> -% ClassName = ClassDef#classdef.name, FormalParams = get_pt_args(ObjectSetDef), OSet = case get_pt_spec(ObjectSetDef) of - {valueset,Set} -> -% #'ObjectSet'{class=name2Extref(S#state.mname, -% ClassName),set=Set}; - #'ObjectSet'{class=ClassRef,set=Set}; - Set when is_record(Set,'ObjectSet') -> Set; - _ -> - error({type,"parameterized object set failure",S}) + {valueset,Set} -> #'ObjectSet'{class=ClassRef,set=Set}; + Set when is_record(Set,'ObjectSet') -> Set; + _ -> asn1_error(S, invalid_objectset) end, MatchedArgs = match_args(S,FormalParams,ArgsList,[]), -% NewS = S#state{type=ObjectSetDef,parameters=MatchedArgs++OldArgs}, NewS = S#state{type=ObjectSetDef,parameters=MatchedArgs}, check_object(NewS,ObjectSetDef,OSet). @@ -3050,9 +3044,9 @@ notify_if_not_ptype(S,#pobjectsetdef{class=Cl}) -> _ -> throw(pobjectsetdef) end; -notify_if_not_ptype(_S,PT) -> - throw({error,{"supposed to be a parameterized type",PT}}). -% fix me +notify_if_not_ptype(S, PT) -> + asn1_error(S, {param_bad_type, error_value(PT)}). + instantiate_ptype(S,Ptypedef,ParaList) -> #ptypedef{args=Args,typespec=Type} = Ptypedef, NewType = check_ptype(S,Ptypedef,Type#type{inlined=yes}), @@ -4082,9 +4076,10 @@ match_parameter(_S, {valueset,#type{def=#'Externaltypereference'{type=Name}}}, %% When a parameter is a parameterized element it has to be %% instantiated now! match_parameter(S, {valueset,T=#type{def={pt,_,_Args}}}, _Ps) -> - case catch check_type(S,#typedef{name=S#state.tname,typespec=T},T) of - pobjectsetdef -> - + try check_type(S,#typedef{name=S#state.tname,typespec=T},T) of + #type{def=Ts} -> + Ts + catch pobjectsetdef -> {_,ObjRef,_Params} = T#type.def, {_,ObjDef}=get_referenced_type(S,ObjRef), %%ObjDef is a pvaluesetdef where the type field holds the class @@ -4102,11 +4097,9 @@ match_parameter(S, {valueset,T=#type{def={pt,_,_Args}}}, _Ps) -> ObjectSet = #'ObjectSet'{class=RightClassRef,set=T}, ObjSpec = check_object(S,#typedef{typespec=ObjectSet},ObjectSet), Name = list_to_atom(asn1ct_gen:list2name([get_datastr_name(ObjDef)|S#state.recordtopname])), - save_object_set_instance(S,Name,ObjSpec); - pvaluesetdef -> error({pvaluesetdef,"parameterized valueset",S}); - {error,_Reason} -> error({type,"error in parameter",S}); - Ts when is_record(Ts,type) -> Ts#type.def + save_object_set_instance(S,Name,ObjSpec) end; + %% same as previous, only depends on order of parsing match_parameter(S, {valueset,{pos,{objectset,_,POSref},Args}}, Ps) -> match_parameter(S, {valueset,#type{def={pt,POSref,Args}}}, Ps); @@ -5853,6 +5846,8 @@ format_error({invalid_bit_number,Bit}) -> io_lib:format("the bit number '~p' is invalid", [Bit]); format_error(invalid_table_constraint) -> "the table constraint is not an object set"; +format_error(invalid_objectset) -> + "expecting an object set"; format_error({implicit_tag_before,Kind}) -> "illegal implicit tag before " ++ case Kind of @@ -5873,6 +5868,8 @@ format_error(multiple_uniqs) -> "implementation limitation: only one UNIQUE field is allowed in CLASS"; format_error({namelist_redefinition,Name}) -> io_lib:format("the name '~s' can not be redefined", [Name]); +format_error({param_bad_type, Ref}) -> + io_lib:format("'~p' is not a parameterized type", [Ref]); format_error(param_wrong_number_of_arguments) -> "wrong number of arguments"; format_error(reversed_range) -> -- cgit v1.2.3 From f9722ef3a20da914911deb8e007080953690046a Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Mon, 8 Dec 2014 12:18:27 +0100 Subject: Modernize the remaining cases --- lib/asn1/src/asn1ct_check.erl | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 0f73f21582..186ea8b5eb 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -3865,7 +3865,7 @@ get_referenced(S,Emod,Ename,Pos) -> %% May be an imported entity in module Emod or Emod may not exist case asn1_db:dbget(Emod,'MODULE') of undefined -> - throw({error,{asn1,{module_not_found,Emod}}}); + asn1_error(S, {undefined_import, Ename, Emod}); _ -> NewS = update_state(S,Emod), get_imported(NewS,Ename,Emod,Pos) @@ -3895,12 +3895,11 @@ get_imported(S,Name,Module,Pos) -> parse_and_save(S,Imodule), case asn1_db:dbget(Imodule,'MODULE') of undefined -> - throw({error,{asn1,{module_not_found,Imodule}}}); + asn1_error(S, {undefined_import, Name, Module}); Im when is_record(Im,module) -> case is_exported(Im,Name) of false -> - throw({error, - {asn1,{not_exported,{Im,Name}}}}); + asn1_error(S, {undefined_export, Name}); _ -> ?dbg("get_imported, is_exported ~p, ~p~n",[Imodule,Name]), get_referenced_type(S, @@ -5252,9 +5251,7 @@ evaluate_atpath(S=#state{abscomppath=TopPath},NamePath,Cnames,{outermost,AtPath= {_,[H|_T]} -> case lists:member(H,Cnames) of true -> [AtPathBelowTop]; - _ -> - %% error({type,{asn1,"failed to analyze at-path",AtPath},S}) - throw({type,{asn1,"failed to analyze at-path",AtPath},S}) + _ -> asn1_error(S, {invalid_at_path, AtPath}) end end; evaluate_atpath(_,_,_,_) -> @@ -5477,8 +5474,7 @@ value_match(S,#'ComponentType'{typespec=Type},Name,[At|Ats],Acc) -> InnerType = asn1ct_gen:get_inner(Type#type.def), Components = case get_atlist_components(Type#type.def) of - [] -> error({type,{asn1,"element in at list must be a " - "SEQUENCE, SET or CHOICE.",Name},S}); + [] -> asn1_error(S, {invalid_element, Name}); Comps -> Comps end, {Index,ValueIndex} = component_value_index(S,InnerType,At,Components), @@ -5498,8 +5494,7 @@ component_index1(_S,Name,[#'ComponentType'{name=Name}|_Cs],N) -> component_index1(S,Name,[_C|Cs],N) -> component_index1(S,Name,Cs,N+1); component_index1(S,Name,[],_) -> - error({type,{asn1,"component of at-list was not" - " found in substructure",Name},S}). + asn1_error(S, {invalid_at_list, Name}). get_unique_fieldname(S, #classdef{typespec=TS}) -> Fields = TS#objectclass.fields, -- cgit v1.2.3 From e231f962defbfac7d5a2646ab6f1443261b2e8a2 Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Fri, 28 Nov 2014 11:55:34 +0100 Subject: Remove old error handling And while we are at it cleanup and rewrite code to use try catch. --- lib/asn1/src/asn1ct_check.erl | 194 +++++++++++++----------------------------- 1 file changed, 57 insertions(+), 137 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 186ea8b5eb..cdc8c6951a 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -23,8 +23,6 @@ %% Main Module for ASN.1 compile time functions %-compile(export_all). -%% Avoid warning for local function error/1 clashing with autoimported BIF. --compile({no_auto_import,[error/1]}). -export([check/2,storeindb/2,format_error/1]). %-define(debug,1). -include("asn1_records.hrl"). @@ -299,7 +297,7 @@ do_checkt(S, Name, #typedef{typespec=TypeSpec}=Type0) -> end catch {error,Reason} -> - error({type,Reason,NewS}); + Reason; {asn1_class,_ClassDef} -> {asn1_class,Name}; pobjectsetdef -> @@ -347,7 +345,7 @@ do_checkv(S, Name, Value) ok catch {error,Reason} -> - error({value,Reason,NewS}); + Reason; {pobjectsetdef} -> {pobjectsetdef,Name}; {objectsetdef} -> @@ -376,7 +374,7 @@ do_checkp(S0, Name, #ptypedef{typespec=TypeSpec}=Type0) -> ok catch {error,Reason} -> - error({type,Reason,S}); + Reason; {asn1_class,_ClassDef} -> {asn1_class,Name}; {asn1_param_class,_} -> @@ -388,38 +386,31 @@ checkc(S, Names) -> check_fold(S, Names, fun do_checkc/3). do_checkc(S, Name, Class) -> - case is_classname(Name) of - false -> - return_asn1_error(S, {illegal_class_name,Name}); - true -> - do_checkc_1(S, Name, Class) + try + case is_classname(Name) of + false -> + asn1_error(S, {illegal_class_name,Name}); + true -> + do_checkc_1(S, Name, Class) + end + catch {error,Reason} -> Reason end. do_checkc_1(S, Name, #classdef{}=Class) -> - try check_class(S, Class) of - C -> - store_class(S, true, Class#classdef{typespec=C}, Name), - ok - catch - {error,Reason} -> - error({class,Reason,S}) - end; + C = check_class(S, Class), + store_class(S, true, Class#classdef{typespec=C}, Name), + ok; do_checkc_1(S, Name, #typedef{typespec=#type{def=Def}=TS}) -> - try check_class(S, TS) of - C -> - {Mod,Pos} = case Def of - #'Externaltypereference'{module=M, pos=P} -> - {M,P}; - {pt, #'Externaltypereference'{module=M, pos=P}, _} -> - {M,P} - end, - Class = #classdef{name=Name, typespec=C, pos=Pos, module=Mod}, - store_class(S, true, Class, Name), - ok - catch - {error,Reason} -> - error({class,Reason,S}) - end. + C = check_class(S, TS), + {Mod,Pos} = case Def of + #'Externaltypereference'{module=M, pos=P} -> + {M,P}; + {pt, #'Externaltypereference'{module=M, pos=P}, _} -> + {M,P} + end, + Class = #classdef{name=Name, typespec=C, pos=Pos, module=Mod}, + store_class(S, true, Class, Name), + ok. %% is_classname(Atom) -> true|false. is_classname(Name) when is_atom(Name) -> @@ -432,71 +423,43 @@ is_classname(Name) when is_atom(Name) -> checko(S0,[Name|Os],Acc,ExclO,ExclOS) -> Item = asn1_db:dbget(S0#state.mname, Name), S = S0#state{error_context=Item}, - Result = - case Item of - Object when is_record(Object,typedef) -> - NewS = S#state{type=Object,tname=Name}, - case catch(check_object(NewS,Object,Object#typedef.typespec)) of - {error,Reason} -> - error({type,Reason,NewS}); - {'EXIT',Reason} -> - error({type,{internal_error,Reason},NewS}); - O -> - NewObj = Object#typedef{checked=true,typespec=O}, - asn1_db:dbput(NewS#state.mname,Name,NewObj), - if - is_record(O,'Object') -> - case O#'Object'.gen of - true -> - {ok,ExclO,ExclOS}; - false -> - {ok,[Name|ExclO],ExclOS} - end; - is_record(O,'ObjectSet') -> - case O#'ObjectSet'.gen of - true -> - {ok,ExclO,ExclOS}; - false -> - {ok,ExclO,[Name|ExclOS]} - end - end - end; - PObject when is_record(PObject,pobjectdef) -> - NewS = S#state{type=PObject,tname=Name}, - case (catch check_pobject(NewS,PObject)) of - {error,Reason} -> - error({type,Reason,NewS}); - {'EXIT',Reason} -> - error({type,{internal_error,Reason},NewS}); - PO -> - NewPObj = PObject#pobjectdef{def=PO}, - asn1_db:dbput(NewS#state.mname,Name,NewPObj), - {ok,[Name|ExclO],ExclOS} - end; - PObjSet when is_record(PObjSet,pvaluesetdef) -> - %% this is a parameterized object set. Might be a parameterized - %% value set, couldn't it? - NewS = S#state{type=PObjSet,tname=Name}, - case (catch check_pobjectset(NewS,PObjSet)) of - {error,Reason} -> - error({type,Reason,NewS}); - {'EXIT',Reason} -> - error({type,{internal_error,Reason},NewS}); - POS -> - %%NewPObjSet = PObjSet#pvaluesetdef{valueset=POS}, - asn1_db:dbput(NewS#state.mname,Name,POS), - {ok,ExclO,[Name|ExclOS]} - end - end, - case Result of - {ok,NewExclO,NewExclOS} -> - checko(S,Os,Acc,NewExclO,NewExclOS); - _ -> - checko(S,Os,[Result|Acc],ExclO,ExclOS) + try checko_1(S, Item, Name, ExclO, ExclOS) of + {NewExclO,NewExclOS} -> + checko(S, Os, Acc, NewExclO, NewExclOS) + catch + throw:{error, Error} -> + checko(S, Os, [Error|Acc], ExclO, ExclOS) end; checko(_S,[],Acc,ExclO,ExclOS) -> {lists:reverse(Acc),lists:reverse(ExclO),lists:reverse(ExclOS)}. +checko_1(S, #typedef{typespec=TS}=Object, Name, ExclO, ExclOS) -> + NewS = S#state{type=Object,tname=Name}, + O = check_object(NewS, Object, TS), + NewObj = Object#typedef{checked=true,typespec=O}, + asn1_db:dbput(NewS#state.mname, Name, NewObj), + case O of + #'Object'{gen=true} -> + {ExclO,ExclOS}; + #'Object'{gen=false} -> + {[Name|ExclO],ExclOS}; + #'ObjectSet'{gen=true} -> + {ExclO,ExclOS}; + #'ObjectSet'{gen=false} -> + {ExclO,[Name|ExclOS]} + end; +checko_1(S, #pobjectdef{}=PObject, Name, ExclO, ExclOS) -> + NewS = S#state{type=PObject,tname=Name}, + PO = check_pobject(NewS, PObject), + NewPObj = PObject#pobjectdef{def=PO}, + asn1_db:dbput(NewS#state.mname, Name, NewPObj), + {[Name|ExclO],ExclOS}; +checko_1(S, #pvaluesetdef{}=PObjSet, Name, ExclO, ExclOS) -> + NewS = S#state{type=PObjSet,tname=Name}, + POS = check_pobjectset(NewS, PObjSet), + asn1_db:dbput(NewS#state.mname, Name, POS), + {ExclO,[Name|ExclOS]}. + check_class(S,CDef=#classdef{checked=Ch,name=Name,typespec=TS}) -> case Ch of true -> TS; @@ -5915,49 +5878,6 @@ format_elements([H1,H2|T]) -> format_elements([H]) -> io_lib:format("~p", [H]). -error({_,{structured_error,_,_,_}=SE,_}) -> - SE; -error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}}) - when is_record(Type,type) -> - io:format("asn1error:~p:~p~n~p~n", - [Mname,Typename,Msg]), - {error,{type,Mname,Typename,Msg}}; -error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}}) - when is_record(Type,typedef) -> - io:format("asn1error:~p:~p:~p~n~p~n", - [Type#typedef.pos,Mname,Typename,Msg]), - {error,{type,Type#typedef.pos,Mname,Typename,Msg}}; -error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}}) - when is_record(Type,ptypedef) -> - io:format("asn1error:~p:~p:~p~n~p~n", - [Type#ptypedef.pos,Mname,Typename,Msg]), - {error,{type,Type#ptypedef.pos,Mname,Typename,Msg}}; -error({type,Msg,#state{mname=Mname,value=Value,vname=Valuename}}) - when is_record(Value,valuedef) -> - io:format("asn1error:~p:~p:~p~n~p~n",[Value#valuedef.pos,Mname,Valuename,Msg]), - {error,{type,Value#valuedef.pos,Mname,Valuename,Msg}}; -error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}}) - when is_record(Type,pobjectdef) -> - io:format("asn1error:~p:~p:~p~n~p~n", - [Type#pobjectdef.pos,Mname,Typename,Msg]), - {error,{type,Type#pobjectdef.pos,Mname,Typename,Msg}}; -error({value,Msg,#state{mname=Mname,value=Value,vname=Valuename}}) - when is_record(Value,valuedef) -> - io:format("asn1error:~p:~p:~p~n~p~n",[Value#valuedef.pos,Mname,Valuename,Msg]), - {error,{value,Value#valuedef.pos,Mname,Valuename,Msg}}; -error({Other,Msg,#state{mname=Mname,value=#valuedef{pos=Pos},vname=Valuename}}) -> - io:format("asn1error:~p:~p:~p~n~p~n",[Pos,Mname,Valuename,Msg]), - {error,{Other,Pos,Mname,Valuename,Msg}}; -error({Other,Msg,#state{mname=Mname,type=#typedef{pos=Pos},tname=Typename}}) -> - io:format("asn1error:~p:~p:~p~n~p~n",[Pos,Mname,Typename,Msg]), - {error,{Other,Pos,Mname,Typename,Msg}}; -error({Other,Msg,#state{mname=Mname,type=#classdef{pos=Pos},tname=Typename}}) -> - io:format("asn1error:~p:~p:~p~n~p~n",[Pos,Mname,Typename,Msg]), - {error,{Other,Pos,Mname,Typename,Msg}}; -error({Other,Msg,#state{mname=Mname,type=Type,tname=Typename}}) -> - io:format("asn1error:~p:~p:~p~n~p~n",[asn1ct:get_pos_of_def(Type),Mname,Typename,Msg]), - {error,{Other,asn1ct:get_pos_of_def(Type),Mname,Typename,Msg}}. - include_default_type(Module) -> NameAbsList = default_type_list(), include_default_type1(Module,NameAbsList). -- cgit v1.2.3 From 819d4c5622c7c90e2929e349a8f8f2a9df4c72a2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 8 Dec 2014 16:35:56 +0100 Subject: Remove vestiges of obsolete {TypeName,Value} notation --- lib/asn1/src/asn1ct_check.erl | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index cdc8c6951a..2c781b7632 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2017,8 +2017,6 @@ normalize_value(S0, Type, {'DEFAULT',Value}, NameList) -> normalize_value(S,Type,Val,NameList) -> normalize_value(S,Type,{'DEFAULT',Val},NameList). -normalize_boolean(S,{Name,Bool},CType) when is_atom(Name) -> - normalize_boolean(S,Bool,CType); normalize_boolean(_,true,_) -> true; normalize_boolean(_,false,_) -> @@ -2382,10 +2380,7 @@ normalize_restrictedstring(_S,CString,_) when is_list(CString) -> %% definedvalue case or argument in a parameterized type normalize_restrictedstring(S,ERef,CType) when is_record(ERef,'Externalvaluereference') -> get_normalized_value(S,ERef,CType, - fun normalize_restrictedstring/3,[]); -%% -normalize_restrictedstring(S,{Name,Val},CType) when is_atom(Name) -> - normalize_restrictedstring(S,Val,CType). + fun normalize_restrictedstring/3,[]). normalize_objectclassfieldvalue(S,{opentypefieldvalue,Type,Value},NameList) -> %% An open type has per definition no type. Thus should the type -- cgit v1.2.3 From 92f5fe1fdd4982a48fe903b8d864501cc3e7e6c2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 16 Dec 2014 07:43:22 +0100 Subject: Remove useless fields in #state{} Three fields ('type','value', and 'vname') are almost unused. They are set, but almost never read. Eliminate the last remaining uses and the fields themselves. --- lib/asn1/src/asn1_records.hrl | 3 -- lib/asn1/src/asn1ct_check.erl | 74 +++++++++++++++++-------------------------- 2 files changed, 29 insertions(+), 48 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1_records.hrl b/lib/asn1/src/asn1_records.hrl index a67c2e5cb2..84435b2d21 100644 --- a/lib/asn1/src/asn1_records.hrl +++ b/lib/asn1/src/asn1_records.hrl @@ -84,10 +84,7 @@ -record(state, {module, mname, - type, tname, - value, - vname, erule, parameters=[], inputmodules=[], diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 2c781b7632..c97f6cb5d1 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -282,7 +282,7 @@ checkt(S0, Names) -> check_fold(S0, lists:reverse(CtxtSwitch), Check) ++ Types. do_checkt(S, Name, #typedef{typespec=TypeSpec}=Type0) -> - NewS = S#state{type=Type0,tname=Name}, + NewS = S#state{tname=Name}, try check_type(NewS, Type0, TypeSpec) of #type{}=Ts -> case Type0#typedef.checked of @@ -331,17 +331,16 @@ do_checkv(S, Name, Value) is_record(Value, typedef); %Value set may be parsed as object set. is_record(Value, pvaluedef); is_record(Value, pvaluesetdef) -> - NewS = S#state{value=Value}, - try check_value(NewS, Value) of + try check_value(S, Value) of {valueset,VSet} -> Pos = asn1ct:get_pos_of_def(Value), CheckedVSDef = #typedef{checked=true,pos=Pos, name=Name,typespec=VSet}, - asn1_db:dbput(NewS#state.mname, Name, CheckedVSDef), + asn1_db:dbput(S#state.mname, Name, CheckedVSDef), {valueset,Name}; V -> %% update the valuedef - asn1_db:dbput(NewS#state.mname, Name, V), + asn1_db:dbput(S#state.mname, Name, V), ok catch {error,Reason} -> @@ -357,7 +356,7 @@ do_checkv(S, Name, Value) ClassName = Type#type.def, NewSpec = #'Object'{classname=ClassName,def=Def}, NewDef = #typedef{checked=C,pos=Pos,name=N,typespec=NewSpec}, - asn1_db:dbput(NewS#state.mname, Name, NewDef), + asn1_db:dbput(S#state.mname, Name, NewDef), {objectdef,Name} end. @@ -366,7 +365,7 @@ checkp(S, Names) -> check_fold(S, Names, fun do_checkp/3). do_checkp(S0, Name, #ptypedef{typespec=TypeSpec}=Type0) -> - S = S0#state{type=Type0,tname=Name}, + S = S0#state{tname=Name}, try check_ptype(S, Type0, TypeSpec) of #type{}=Ts -> Type = Type0#ptypedef{checked=true,typespec=Ts}, @@ -434,7 +433,7 @@ checko(_S,[],Acc,ExclO,ExclOS) -> {lists:reverse(Acc),lists:reverse(ExclO),lists:reverse(ExclOS)}. checko_1(S, #typedef{typespec=TS}=Object, Name, ExclO, ExclOS) -> - NewS = S#state{type=Object,tname=Name}, + NewS = S#state{tname=Name}, O = check_object(NewS, Object, TS), NewObj = Object#typedef{checked=true,typespec=O}, asn1_db:dbput(NewS#state.mname, Name, NewObj), @@ -449,13 +448,13 @@ checko_1(S, #typedef{typespec=TS}=Object, Name, ExclO, ExclOS) -> {ExclO,[Name|ExclOS]} end; checko_1(S, #pobjectdef{}=PObject, Name, ExclO, ExclOS) -> - NewS = S#state{type=PObject,tname=Name}, + NewS = S#state{tname=Name}, PO = check_pobject(NewS, PObject), NewPObj = PObject#pobjectdef{def=PO}, asn1_db:dbput(NewS#state.mname, Name, NewPObj), {[Name|ExclO],ExclOS}; checko_1(S, #pvaluesetdef{}=PObjSet, Name, ExclO, ExclOS) -> - NewS = S#state{type=PObjSet,tname=Name}, + NewS = S#state{tname=Name}, POS = check_pobjectset(NewS, PObjSet), asn1_db:dbput(NewS#state.mname, Name, POS), {ExclO,[Name|ExclOS]}. @@ -479,8 +478,7 @@ check_class(S = #state{mname=M,tname=T},ClassSpec) Tref = #'Externaltypereference'{type=TName} -> {MName,RefType} = get_referenced_type(S,Tref), #classdef{} = CD = get_class_def(S, RefType), - NewState = update_state(S#state{type=RefType, - tname=TName}, MName), + NewState = update_state(S#state{tname=TName}, MName), check_class(NewState, CD); {pt,ClassRef,Params} -> %% parameterized class @@ -502,8 +500,7 @@ check_class(S,ClassName) -> false -> Name=ClassName#'Externaltypereference'.type, store_class(S,idle,ClassDef,Name), -% NewS = S#state{mname=RefMod,type=Def,tname=Name}, - NewS = update_state(S#state{type=Def,tname=Name},RefMod), + NewS = update_state(S#state{tname=Name}, RefMod), CheckedTS = check_class(NewS,ClassDef#classdef.typespec), store_class(S,true,ClassDef#classdef{typespec=CheckedTS},Name), CheckedTS @@ -530,8 +527,7 @@ check_objectclass(S, #objectclass{fields=Fs0,syntax=Syntax0}=C) -> instantiate_pclass(S=#state{parameters=_OldArgs},PClassDef,Params) -> #ptypedef{args=Args,typespec=Type} = PClassDef, MatchedArgs = match_args(S,Args, Params, []), -% NewS = S#state{type=Type,parameters=MatchedArgs++OldArgs,abscomppath=[]}, - NewS = S#state{type=Type,parameters=MatchedArgs,abscomppath=[]}, + NewS = S#state{parameters=MatchedArgs,abscomppath=[]}, check_class(NewS,#classdef{name=S#state.tname,typespec=Type}). store_class(S,Mode,ClassDef,ClassName) -> @@ -684,7 +680,7 @@ check_object(S,_ObjDef,#'Object'{classname=ClassRef,def=ObjectDef}) -> case get_referenced_type(S, ClassRef, true) of {MName,#classdef{checked=false, name=CLName}=ClDef} -> Type = ClassRef#'Externaltypereference'.type, - NewState = update_state(S#state{type=ClDef, tname=Type}, MName), + NewState = update_state(S#state{tname=Type}, MName), ObjClass = check_class(NewState, ClDef), {ClDef#classdef{checked=true, typespec=ObjClass}, #'Externaltypereference'{module=MName, type=CLName}}; @@ -903,7 +899,7 @@ remove_duplicate_objects_1(S, [{Id,[_|_]=Objs}|T]) -> [{_,Obj}] -> [Obj|remove_duplicate_objects_1(S, T)]; [_|_] -> - asn1_error(S, S#state.type, {non_unique_object,Id}) + asn1_error(S, {non_unique_object,Id}) end; remove_duplicate_objects_1(_, []) -> []. @@ -1135,8 +1131,7 @@ check_fieldname_element_1(S, Eref) instantiate_po(S=#state{parameters=_OldArgs},_ClassDef,Object,ArgsList) when is_record(Object,pobjectdef) -> FormalParams = get_pt_args(Object), MatchedArgs = match_args(S,FormalParams,ArgsList,[]), -% NewS = S#state{type=Object,parameters=MatchedArgs++OldArgs}, - NewS = S#state{type=Object,parameters=MatchedArgs}, + NewS = S#state{parameters=MatchedArgs}, check_object(NewS,Object,#'Object'{classname=Object#pobjectdef.class, def=Object#pobjectdef.def}). @@ -1153,7 +1148,7 @@ instantiate_pos(S=#state{parameters=_OldArgs},ClassRef,ObjectSetDef,ArgsList) -> _ -> asn1_error(S, invalid_objectset) end, MatchedArgs = match_args(S,FormalParams,ArgsList,[]), - NewS = S#state{type=ObjectSetDef,parameters=MatchedArgs}, + NewS = S#state{parameters=MatchedArgs}, check_object(NewS,ObjectSetDef,OSet). @@ -1475,8 +1470,7 @@ match_syntax_type(_S, _Type, _Actual) -> match_syntax_params(S0, #ptypedef{name=Name}=PtDef, #'Externaltypereference'{module=M,type=N}=ERef0, Args) -> - S = S0#state{mname=M,module=load_asn1_module(S0, M), - type=PtDef,tname=Name}, + S = S0#state{mname=M,module=load_asn1_module(S0, M),tname=Name}, Type = check_type(S, PtDef, #type{def={pt,ERef0,Args}}), ERefName = new_reference_name(N), ERef = #'Externaltypereference'{type=ERefName,module=S0#state.mname}, @@ -1495,7 +1489,7 @@ match_syntax_external(#state{mname=Mname}=S0, Name, Ref0) -> %% This typedef is an imported type (or maybe a set.asn %% compilation). S = S0#state{mname=M,module=load_asn1_module(S0, M), - type=TDef0,tname=get_datastr_name(TDef0)}, + tname=get_datastr_name(TDef0)}, Type = check_type(S, TDef0, TDef0#typedef.typespec), TDef = TDef0#typedef{checked=true,typespec=Type}, asn1_db:dbput(M, get_datastr_name(TDef), TDef), @@ -1720,7 +1714,7 @@ check_valuedef(#state{recordtopname=TopName}=S0, V0) -> V = V0#valuedef{checked=true}, Vtype = check_type(S0, #typedef{name=Name,typespec=Vtype0},Vtype0), Def = Vtype#type.def, - S1 = S0#state{type=Vtype,tname=Def,value=V0,vname=Name}, + S1 = S0#state{tname=Def}, SVal = update_state(S1, ModName), case Def of #'Externaltypereference'{type=RecName}=Ext -> @@ -1758,7 +1752,7 @@ check_valuedef(#state{recordtopname=TopName}=S0, V0) -> {'INTEGER',_NamedNumberList} -> V#valuedef{value=normalize_value(SVal, Vtype, Value, [])}; #'SEQUENCE'{} -> - {ok,SeqVal} = convert_external(SVal, Value), + {ok,SeqVal} = convert_external(SVal, Vtype, Value), V#valuedef{value=normalize_value(SVal, Vtype, SeqVal, TopName)}; _ -> V#valuedef{value=normalize_value(SVal, Vtype, Value, TopName)} @@ -1928,7 +1922,7 @@ validate_oid_path(S, o_id=OidType, _) -> %%% End of OBJECT IDENTFIER/RELATIVE-OID validation. %%% -convert_external(S=#state{type=Vtype}, Value) -> +convert_external(S, Vtype, Value) -> case Vtype of #type{tag=[{tag,'UNIVERSAL',8,'IMPLICIT',32}]} -> %% this is an 'EXTERNAL' (or INSTANCE OF) @@ -1971,17 +1965,16 @@ normalize_value(_,_,mandatory,_) -> mandatory; normalize_value(_,_,'OPTIONAL',_) -> 'OPTIONAL'; -normalize_value(S0, Type, {'DEFAULT',Value}, NameList) -> - S = S0#state{value=Value}, +normalize_value(S, Type, {'DEFAULT',Value}, NameList) -> case catch get_canonic_type(S,Type,NameList) of {'BOOLEAN',CType,_} -> normalize_boolean(S,Value,CType); {'INTEGER',CType,_} -> - normalize_integer(S0, Value, CType); + normalize_integer(S, Value, CType); {'BIT STRING',CType,_} -> normalize_bitstring(S,Value,CType); {'OCTET STRING',_,_} -> - normalize_octetstring(S0, Value); + normalize_octetstring(S, Value); {'NULL',_CType,_} -> %%normalize_null(Value); 'NULL'; @@ -2043,8 +2036,7 @@ normalize_integer(S, #'Externalvaluereference'{value=Name}=Ref, NNL) -> asn1_error(S, illegal_integer_value) end end; -normalize_integer(S0, {'ValueFromObject',{object,Obj},FieldNames}, _) -> - S = S0#state{type=S0#state.value}, +normalize_integer(S, {'ValueFromObject',{object,Obj},FieldNames}, _) -> case extract_field(S, Obj, FieldNames) of #valuedef{value=Val} when is_integer(Val) -> Val; @@ -2169,7 +2161,7 @@ lookup_enum_value(S, Id, NNL) when is_atom(Id) -> {_,_}=Ret -> Ret; false -> - asn1_error(S, S#state.value, {undefined,Id}) + asn1_error(S, {undefined,Id}) end. normalize_choice(S, {'CHOICE',{C,V}}, CType, NameList) @@ -2551,7 +2543,6 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> NewS = S#state{mname=RefMod, module=load_asn1_module(S,RefMod), tname=get_datastr_name(NewRefTypeDef1), - type=NewRefTypeDef1, abscomppath=[],recordtopname=[]}, RefType1 = check_type(NewS,RefTypeDef,RefTypeDef#typedef.typespec), @@ -3010,8 +3001,7 @@ instantiate_ptype(S,Ptypedef,ParaList) -> NewType = check_ptype(S,Ptypedef,Type#type{inlined=yes}), MatchedArgs = match_args(S,Args, ParaList, []), OldArgs = S#state.parameters, - NewS = S#state{type=NewType,parameters=MatchedArgs++OldArgs,abscomppath=[]}, -%% NewS = S#state{type=NewType,parameters=MatchedArgs,abscomppath=[]}, + NewS = S#state{parameters=MatchedArgs++OldArgs,abscomppath=[]}, check_type(NewS, Ptypedef#ptypedef{typespec=NewType}, NewType). get_datastr_name(Type) -> @@ -4641,7 +4631,6 @@ check_selectiontype(S,Name,#type{def=Eref}) {RefMod,TypeDef} = get_referenced_type(S,Eref), NewS = S#state{module=load_asn1_module(S,RefMod), mname=RefMod, - type=TypeDef, tname=get_datastr_name(TypeDef)}, check_selectiontype2(NewS,Name,TypeDef); check_selectiontype(S,Name,Type=#type{def={pt,_,_}}) -> @@ -5550,15 +5539,13 @@ get_OCFType(S,Fields,[PrimFieldName|Rest]) -> {fixedtypevaluefield,PrimFieldName,Type}; {value,{objectfield,_,ClassRef,_Unique,_OptSpec}} -> {MName,ClassDef} = get_referenced_type(S,ClassRef), - NewS = update_state(S#state{type=ClassDef, - tname=get_datastr_name(ClassDef)}, + NewS = update_state(S#state{tname=get_datastr_name(ClassDef)}, MName), CheckedCDef = check_class(NewS,ClassDef), get_OCFType(S,CheckedCDef#objectclass.fields,Rest); {value,{objectsetfield,_,Type,_OptSpec}} -> {MName,ClassDef} = get_referenced_type(S,Type#type.def), - NewS = update_state(S#state{type=ClassDef, - tname=get_datastr_name(ClassDef)}, + NewS = update_state(S#state{tname=get_datastr_name(ClassDef)}, MName), CheckedCDef = check_class(NewS,ClassDef), get_OCFType(S,CheckedCDef#objectclass.fields,Rest); @@ -5739,9 +5726,6 @@ return_asn1_error(#state{mname=Where}, Item, Error) -> asn1_error(S, Error) -> throw({error,return_asn1_error(S, Error)}). -asn1_error(S, Item, Error) -> - throw({error,return_asn1_error(S, Item, Error)}). - format_error({already_defined,Name,PrevLine}) -> io_lib:format("the name ~p has already been defined at line ~p", [Name,PrevLine]); -- cgit v1.2.3 From ac5c60b0de2ef93a99f6c39f3e251f526f303964 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 16 Dec 2014 10:10:01 +0100 Subject: Reimplement storeindb/2 to avoid excessive process communication As currently implemented, there is one call to asn1db:dbget() and asn1db:dbput() for each type/value definitions in an ASN.1 specification. If we check for duplicate definitions locally, we can send all definitions in a single call. --- lib/asn1/src/asn1_db.erl | 8 +++++- lib/asn1/src/asn1ct_check.erl | 60 ++++++++++++++++++++++++++----------------- 2 files changed, 44 insertions(+), 24 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1_db.erl b/lib/asn1/src/asn1_db.erl index 48d9dd16d7..5577969727 100644 --- a/lib/asn1/src/asn1_db.erl +++ b/lib/asn1/src/asn1_db.erl @@ -19,7 +19,8 @@ %% -module(asn1_db). --export([dbstart/1,dbnew/2,dbload/1,dbload/3,dbsave/2,dbput/3,dbget/2]). +-export([dbstart/1,dbnew/2,dbload/1,dbload/3,dbsave/2,dbput/2, + dbput/3,dbget/2]). -export([dbstop/0]). -record(state, {parent, monitor, includes, table}). @@ -44,6 +45,7 @@ dbload(Module) -> dbnew(Module, Erule) -> req({new, Module, Erule}). dbsave(OutFile, Module) -> cast({save, OutFile, Module}). dbput(Module, K, V) -> cast({set, Module, K, V}). +dbput(Module, Kvs) -> cast({set, Module, Kvs}). dbget(Module, K) -> req({get, Module, K}). dbstop() -> Resp = req(stop), erase(?MODULE), Resp. @@ -82,6 +84,10 @@ loop(#state{parent = Parent, monitor = MRef, table = Table, [{_, Modtab}] = ets:lookup(Table, Mod), ets:insert(Modtab, {K2, V}), loop(State); + {set, Mod, Kvs} -> + [{_, Modtab}] = ets:lookup(Table, Mod), + ets:insert(Modtab, Kvs), + loop(State); {From, {get, Mod, K2}} -> %% XXX If there is no information for Mod, get_table/3 %% will attempt to load information from an .asn1db diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index c97f6cb5d1..6cbf9614cb 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -5651,32 +5651,46 @@ merge_tags2([H|T],Acc) -> merge_tags2([], Acc) -> lists:reverse(Acc). -storeindb(S,M) when is_record(M,module) -> - TVlist = M#module.typeorval, - NewM = M#module{typeorval=findtypes_and_values(TVlist)}, - asn1_db:dbnew(NewM#module.name, S#state.erule), - asn1_db:dbput(NewM#module.name,'MODULE', NewM), - Res = storeindb(#state{mname=NewM#module.name}, TVlist, []), - include_default_class(S,NewM#module.name), +storeindb(S0, #module{name=ModName,typeorval=TVlist0}=M) -> + S = S0#state{mname=ModName}, + TVlist1 = [{asn1ct:get_name_of_def(Def),Def} || Def <- TVlist0], + case check_duplicate_defs(S, TVlist1) of + ok -> + storeindb_1(S, M, TVlist0, TVlist1); + {error,_}=Error -> + Error + end. + +storeindb_1(S, #module{name=ModName}=M, TVlist0, TVlist) -> + NewM = M#module{typeorval=findtypes_and_values(TVlist0)}, + asn1_db:dbnew(ModName, S#state.erule), + asn1_db:dbput(ModName, 'MODULE', NewM), + asn1_db:dbput(ModName, TVlist), + include_default_class(S, NewM#module.name), include_default_type(NewM#module.name), - Res. + ok. -storeindb(#state{mname=Module}=S, [H|T], Errors) -> - Name = asn1ct:get_name_of_def(H), - case asn1_db:dbget(Module, Name) of - undefined -> - asn1_db:dbput(Module, Name, H), - storeindb(S, T, Errors); - Prev -> - PrevLine = asn1ct:get_pos_of_def(Prev), - Error = return_asn1_error(S, H, {already_defined,Name,PrevLine}), - storeindb(S, T, [Error|Errors]) - end; -storeindb(_, [], []) -> - ok; -storeindb(_, [], [_|_]=Errors) -> - {error,Errors}. +check_duplicate_defs(S, Defs) -> + Set0 = sofs:relation(Defs), + Set1 = sofs:relation_to_family(Set0), + Set = sofs:to_external(Set1), + case [duplicate_def(S, N, Dup) || {N,[_,_|_]=Dup} <- Set] of + [] -> + ok; + [_|_]=E -> + {error,lists:append(E)} + end. + +duplicate_def(S, Name, Dups0) -> + Dups1 = [{asn1ct:get_pos_of_def(Def),Def} || Def <- Dups0], + [{Prev,_}|Dups] = lists:sort(Dups1), + duplicate_def_1(S, Dups, Name, Prev). +duplicate_def_1(S, [{_,Def}|T], Name, Prev) -> + E = return_asn1_error(S, Def, {already_defined,Name,Prev}), + [E|duplicate_def_1(S, T, Name, Prev)]; +duplicate_def_1(_, [], _, _) -> + []. findtypes_and_values(TVList) -> findtypes_and_values(TVList,[],[],[],[],[],[]).%% Types,Values, -- cgit v1.2.3 From 09cd07962f7c64ec0ccef2ad655bf9977c154bf0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 18 Dec 2014 08:23:58 +0100 Subject: Improve error handling for illegal object definitions --- lib/asn1/src/asn1ct_check.erl | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index 6cbf9614cb..99392d6eaa 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -705,12 +705,14 @@ check_object(S,_ObjDef,#'Object'{classname=ClassRef,def=ObjectDef}) -> instantiate_po(S,ClassDef,Object,ArgList); #'Externalvaluereference'{} -> {_,Object} = get_referenced_type(S,ObjectDef), - check_object(S, Object, object_to_check(Object)); + check_object(S, Object, object_to_check(S, Object)); [] -> %% An object with no fields (parsed as a value). Def = {object,defaultsyntax,[]}, NewSettingList = check_objectdefn(S, Def, ClassDef), - #'Object'{def=NewSettingList} + #'Object'{def=NewSettingList}; + _ -> + asn1_error(S, illegal_object) end, Fields = (ClassDef#classdef.typespec)#objectclass.fields, Gen = gen_incl(S,NewObj#'Object'.def, Fields), @@ -973,12 +975,17 @@ traverse_seq_set_1([{'COMPONENTS OF', _} = CO0|Cs], Fun) -> traverse_seq_set_1([], _) -> []. -object_to_check(#typedef{typespec=ObjDef}) -> +object_to_check(_, #typedef{typespec=ObjDef}) -> ObjDef; -object_to_check(#valuedef{type=ClassName,value=ObjectRef}) -> +object_to_check(S, #valuedef{type=Class,value=ObjectRef}) -> %% If the object definition is parsed as an object the ClassName - %% is parsed as a type - #'Object'{classname=ClassName#type.def,def=ObjectRef}. + %% is parsed as a type. + case Class of + #type{def=#'Externaltypereference'{}=Def} -> + #'Object'{classname=Def,def=ObjectRef}; + _ -> + asn1_error(S, illegal_object) + end. check_referenced_object(S,ObjRef) when is_record(ObjRef,'Externalvaluereference')-> @@ -1182,7 +1189,7 @@ gen_incl1(S,Fields,[C|CFields]) -> check_object(S,TDef,TDef#typedef.typespec); ERef -> {_,T} = get_referenced_type(S,ERef), - check_object(S,T,object_to_check(T)) + check_object(S, T, object_to_check(S, T)) end, case gen_incl(S,ObjDef#'Object'.def, ClassFields) of @@ -1413,7 +1420,7 @@ match_syntax_type(_S, {fixedtypevaluesetfield,Name,#type{},_}, Any) -> {match,[{Name,Any}]}; match_syntax_type(S, {objectfield,Name,_,_,_}, #'Externalvaluereference'{}=Ref) -> {M,Obj} = get_referenced_type(S, Ref), - check_object(S, Obj, object_to_check(Obj)), + check_object(S, Obj, object_to_check(S, Obj)), {match,[{Name,Ref#'Externalvaluereference'{module=M}}]}; match_syntax_type(S, {objectfield,Name,Class,_,_}, {object,_,_}=ObjDef) -> InlinedObjName = list_to_atom(lists:concat([S#state.tname, -- cgit v1.2.3 From 17ec629959088f0b213a5559ab2e793e9ec0f124 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Mon, 12 Jan 2015 11:42:23 +0100 Subject: Remove the old unused yecc-based parser --- lib/asn1/src/asn1ct_parser.yrl | 1177 ---------------------------------------- 1 file changed, 1177 deletions(-) delete mode 100644 lib/asn1/src/asn1ct_parser.yrl (limited to 'lib/asn1/src') diff --git a/lib/asn1/src/asn1ct_parser.yrl b/lib/asn1/src/asn1ct_parser.yrl deleted file mode 100644 index 083162f191..0000000000 --- a/lib/asn1/src/asn1ct_parser.yrl +++ /dev/null @@ -1,1177 +0,0 @@ -%% -%% 1997-2008 -%% Ericsson AB, 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. -%% -%% The Initial Developer of the Original Code is Ericsson AB. -%% -%% -Nonterminals -ModuleDefinition ModuleIdentifier DefinitiveIdentifier DefinitiveObjIdComponentList -DefinitiveObjIdComponent TagDefault ExtensionDefault -ModuleBody Exports SymbolsExported Imports SymbolsImported -SymbolsFromModuleList SymbolsFromModule GlobalModuleReference AssignedIdentifier SymbolList -Symbol Reference AssignmentList Assignment -ExtensionAndException -ComponentTypeLists -Externaltypereference Externalvaluereference DefinedType DefinedValue -AbsoluteReference ItemSpec ItemId ComponentId TypeAssignment -ValueAssignment -% ValueSetTypeAssignment -ValueSet -Type BuiltinType NamedType ReferencedType -Value ValueNotNull BuiltinValue ReferencedValue NamedValue -% BooleanType -BooleanValue IntegerType NamedNumberList NamedNumber SignedNumber -% inlined IntegerValue -EnumeratedType -% inlined Enumerations -Enumeration EnumerationItem -% inlined EnumeratedValue -% RealType -RealValue NumericRealValue SpecialRealValue BitStringType -% inlined BitStringValue -IdentifierList -% OctetStringType -% inlined OctetStringValue -% NullType NullValue -SequenceType ComponentTypeList ComponentType -% SequenceValue SequenceOfValue -ComponentValueList SequenceOfType -SAndSOfValue ValueList SetType -% SetValue SetOfValue -SetOfType -ChoiceType -% AlternativeTypeList made common with ComponentTypeList -ChoiceValue -AnyValue -AnyDefBy -SelectionType -TaggedType Tag ClassNumber Class -% redundant TaggedValue -% EmbeddedPDVType EmbeddedPDVValue ExternalType ExternalValue ObjectIdentifierType -ObjectIdentifierValue ObjIdComponentList ObjIdComponent -% NameForm NumberForm NameAndNumberForm -CharacterStringType -RestrictedCharacterStringValue CharacterStringList -% CharSyms CharsDefn -Quadruple -% Group Plane Row Cell -Tuple -% TableColumn TableRow -% UnrestrictedCharacterString -CharacterStringValue -% UnrestrictedCharacterStringValue -ConstrainedType Constraint ConstraintSpec TypeWithConstraint -ElementSetSpecs ElementSetSpec -%GeneralConstraint -UserDefinedConstraint UserDefinedConstraintParameter -UserDefinedConstraintParameters -ExceptionSpec -ExceptionIdentification -Unions -UnionMark -UElems -Intersections -IntersectionElements -IntersectionMark -IElems -Elements -Elems -SubTypeElements -Exclusions -LowerEndpoint -UpperEndpoint -LowerEndValue -UpperEndValue -TypeConstraints NamedConstraint PresenceConstraint - -ParameterizedTypeAssignment -ParameterList -Parameters -Parameter -ParameterizedType - -% X.681 -ObjectClassAssignment ObjectClass ObjectClassDefn -FieldSpecs FieldSpec OptionalitySpec WithSyntaxSpec -TokenOrGroupSpecs TokenOrGroupSpec -SyntaxList OptionalGroup RequiredToken Word -TypeOptionalitySpec -ValueOrObjectOptSpec -VSetOrOSetOptSpec -ValueOptionalitySpec -ObjectOptionalitySpec -ValueSetOptionalitySpec -ObjectSetOptionalitySpec -% X.681 chapter 15 -InformationFromObjects -ValueFromObject -%ValueSetFromObjects -TypeFromObject -%ObjectFromObject -%ObjectSetFromObjects -ReferencedObjects -FieldName -PrimitiveFieldName - -ObjectAssignment -ObjectSetAssignment -ObjectSet -ObjectSetElements -Object -ObjectDefn -DefaultSyntax -DefinedSyntax -FieldSettings -FieldSetting -DefinedSyntaxTokens -DefinedSyntaxToken -Setting -DefinedObject -ObjectFromObject -ObjectSetFromObjects -ParameterizedObject -ExternalObjectReference -DefinedObjectSet -DefinedObjectClass -ExternalObjectClassReference - -% X.682 -TableConstraint -ComponentRelationConstraint -ComponentIdList - -% X.683 -ActualParameter -. - -%UsefulType. - -Terminals -'ABSENT' 'ABSTRACT-SYNTAX' 'ALL' 'ANY' -'APPLICATION' 'AUTOMATIC' 'BEGIN' 'BIT' -'BOOLEAN' 'BY' 'CHARACTER' 'CHOICE' 'CLASS' 'COMPONENT' -'COMPONENTS' 'CONSTRAINED' 'DEFAULT' 'DEFINED' 'DEFINITIONS' -'EMBEDDED' 'END' 'ENUMERATED' 'EXCEPT' 'EXPLICIT' -'EXPORTS' 'EXTENSIBILITY' 'EXTERNAL' 'FALSE' 'FROM' 'GeneralizedTime' -'TYPE-IDENTIFIER' -'IDENTIFIER' 'IMPLICIT' 'IMPLIED' 'IMPORTS' -'INCLUDES' 'INSTANCE' 'INTEGER' 'INTERSECTION' -'MAX' 'MIN' 'MINUS-INFINITY' 'NULL' -'OBJECT' 'ObjectDescriptor' 'OCTET' 'OF' 'OPTIONAL' 'PDV' 'PLUS-INFINITY' -'PRESENT' 'PRIVATE' 'REAL' 'SEQUENCE' 'SET' 'SIZE' -'STRING' 'SYNTAX' 'TAGS' 'TRUE' 'UNION' -'UNIQUE' 'UNIVERSAL' 'UTCTime' 'WITH' -'{' '}' '(' ')' '.' '::=' ';' ',' '@' '*' '-' '[' ']' -'!' '..' '...' '|' '<' ':' '^' -number identifier typereference restrictedcharacterstringtype -bstring hstring cstring typefieldreference valuefieldreference -objectclassreference word. - -Rootsymbol ModuleDefinition. -Endsymbol '$end'. - -Left 300 'EXCEPT'. -Left 200 '^'. -Left 200 'INTERSECTION'. -Left 100 '|'. -Left 100 'UNION'. - - -ModuleDefinition -> ModuleIdentifier - 'DEFINITIONS' - TagDefault - ExtensionDefault - '::=' - 'BEGIN' - ModuleBody - 'END' : - {'ModuleBody',Ex,Im,Types} = '$7', - {{typereference,Pos,Name},Defid} = '$1', - #module{ - pos= Pos, - name= Name, - defid= Defid, - tagdefault='$3', - extensiondefault='$4', - exports=Ex, - imports=Im, - typeorval=Types}. -% {module, '$1','$3','$6'}. -% Results always in a record of type module defined in asn_records.hlr - -ModuleIdentifier -> typereference DefinitiveIdentifier : - put(asn1_module,'$1'#typereference.val), - {'$1','$2'}. - -DefinitiveIdentifier -> '{' DefinitiveObjIdComponentList '}' : '$2' . -DefinitiveIdentifier -> '$empty': []. - -DefinitiveObjIdComponentList -> DefinitiveObjIdComponent : ['$1']. -DefinitiveObjIdComponentList -> DefinitiveObjIdComponent DefinitiveObjIdComponentList : ['$1'|'$2']. - -DefinitiveObjIdComponent -> identifier : '$1' . %expanded-> -% DefinitiveObjIdComponent -> NameForm : '$1' . -DefinitiveObjIdComponent -> number : '$1' . %expanded-> -% DefinitiveObjIdComponent -> DefinitiveNumberForm : 'fix' . -DefinitiveObjIdComponent -> identifier '(' number ')' : {'$1','$3'} . %expanded-> -% DefinitiveObjIdComponent -> DefinitiveNameAndNumberForm : {'$1','$3'} . - -% DefinitiveNumberForm -> number : 'fix' . - -% DefinitiveNameAndNumberForm -> identifier '(' DefinitiveNumberForm ')' : 'fix' . - -TagDefault -> 'EXPLICIT' 'TAGS' : put(tagdefault,'EXPLICIT'),'EXPLICIT' . -TagDefault -> 'IMPLICIT' 'TAGS' : put(tagdefault,'IMPLICIT'),'IMPLICIT' . -TagDefault -> 'AUTOMATIC' 'TAGS' : put(tagdefault,'AUTOMATIC'),'AUTOMATIC' . -TagDefault -> '$empty': put(tagdefault,'EXPLICIT'),'EXPLICIT'. % because this is the default - -ExtensionDefault -> 'EXTENSIBILITY' 'IMPLIED' : 'IMPLIED'. -ExtensionDefault -> '$empty' : 'false'. % because this is the default - -ModuleBody -> Exports Imports AssignmentList : {'ModuleBody','$1','$2','$3'}. -ModuleBody -> '$empty' : {'ModuleBody',nil,nil,[]}. - -Exports -> 'EXPORTS' SymbolList ';' : {exports,'$2'}. -Exports -> 'EXPORTS' ';' : {exports,[]}. -Exports -> '$empty' : {exports,all} . - -% inlined above SymbolsExported -> SymbolList : '$1'. -% inlined above SymbolsExported -> '$empty' : []. - -Imports -> 'IMPORTS' SymbolsFromModuleList ';' : {imports,'$2'}. -Imports -> 'IMPORTS' ';' : {imports,[]}. -Imports -> '$empty' : {imports,[]} . - -% inlined above SymbolsImported -> SymbolsFromModuleList : '$1'. -% inlined above SymbolsImported -> '$empty' : []. - -SymbolsFromModuleList -> SymbolsFromModule :['$1']. -% SymbolsFromModuleList -> SymbolsFromModuleList SymbolsFromModule :$1.%changed -SymbolsFromModuleList -> SymbolsFromModule SymbolsFromModuleList :['$1'|'$2']. - -% expanded SymbolsFromModule -> SymbolList 'FROM' GlobalModuleReference : #'SymbolsFromModule'{symbols = '$1',module='$3'}. -SymbolsFromModule -> SymbolList 'FROM' typereference : #'SymbolsFromModule'{symbols = '$1',module='$3'}. -SymbolsFromModule -> SymbolList 'FROM' typereference '{' ValueList '}': #'SymbolsFromModule'{symbols = '$1',module='$3'}. -%SymbolsFromModule -> SymbolList 'FROM' typereference identifier: #'SymbolsFromModule'{symbols = '$1',module='$3'}. -%SymbolsFromModule -> SymbolList 'FROM' typereference Externalvaluereference: #'SymbolsFromModule'{symbols = '$1',module='$3'}. -%SymbolsFromModule -> SymbolList 'FROM' typereference DefinedValue: #'SymbolsFromModule'{symbols = '$1',module='$3'}. - -% inlined GlobalModuleReference -> typereference AssignedIdentifier : {'$1','$2'} . - -% inlined above AssignedIdentifier -> '{' ValueList '}' : '$2'. -% replaced AssignedIdentifier -> '{' DefinedValue ObjIdComponentList '}' :{'$2','$3'}. -% not necessary , replaced by SAndSOfValue AssignedIdentifier -> ObjectIdentifierValue :'$1'. -% AssignedIdentifier -> DefinedValue : '$1'. -% inlined AssignedIdentifier -> '$empty' : undefined. - -SymbolList -> Symbol : ['$1']. -SymbolList -> Symbol ',' SymbolList :['$1'|'$3']. - -Symbol -> Reference :'$1'. -% later Symbol -> ParameterizedReference :'$1'. - -Reference -> typereference :'$1'. -Reference -> identifier:'$1'. -Reference -> typereference '{' '}':'$1'. -Reference -> Externaltypereference '{' '}':'$1'. - -% later Reference -> objectclassreference :'$1'. -% later Reference -> objectreference :'$1'. -% later Reference -> objectsetreference :'$1'. - -AssignmentList -> Assignment : ['$1']. -% modified AssignmentList -> AssignmentList Assignment : '$1'. -AssignmentList -> Assignment AssignmentList : ['$1'|'$2']. - -Assignment -> TypeAssignment : '$1'. -Assignment -> ValueAssignment : '$1'. -% later Assignment -> ValueSetTypeAssignment : '$1'. -Assignment -> ObjectClassAssignment : '$1'. -% later Assignment -> ObjectAssignment : '$1'. -% combined with ValueAssignment Assignment -> ObjectAssignment : '$1'. -Assignment -> ObjectSetAssignment : '$1'. -Assignment -> ParameterizedTypeAssignment : '$1'. -%Assignment -> ParameterizedValueAssignment : '$1'. -%Assignment -> ParameterizedValueSetTypeAssignment : '$1'. -%Assignment -> ParameterizedObjectClassAssignment : '$1'. - -ObjectClassAssignment -> typereference '::=' 'CLASS' '{' FieldSpecs '}' : -%ObjectClassAssignment -> objectclassreference '::=' 'CLASS' '{' FieldSpecs '}' : - #typedef{pos=element(2,'$1'),name=element(3,'$1'),typespec={'CLASS','$5',[]}}. -ObjectClassAssignment -> typereference '::=' 'CLASS' '{' FieldSpecs '}' WithSyntaxSpec : -%ObjectClassAssignment -> objectclassreference '::=' 'CLASS' '{' FieldSpecs '}' WithSyntaxSpec : - #typedef{pos=element(2,'$1'),name=element(3,'$1'),typespec={'CLASS','$5','$7'}}. - -FieldSpecs -> FieldSpec : ['$1']. -FieldSpecs -> FieldSpec ',' FieldSpecs : ['$1'|'$3']. - -FieldSpec -> typefieldreference TypeOptionalitySpec : {typefield,'$1','$2'}. - -FieldSpec -> valuefieldreference Type 'UNIQUE' ValueOrObjectOptSpec : - {fixedtypevaluefield,'$1','$2','UNIQUE','$4'}. -FieldSpec -> valuefieldreference Type ValueOrObjectOptSpec : - {fixedtypevaluefield,'$1','$2',undefined,'$3'}. - -FieldSpec -> valuefieldreference typefieldreference ValueOrObjectOptSpec : - {variabletypevaluefield, '$1','$2','$3'}. - -FieldSpec -> typefieldreference typefieldreference VSetOrOSetOptSpec : - {variabletypevaluesetfield, '$1','$2','$3'}. - -FieldSpec -> typefieldreference Type VSetOrOSetOptSpec : - {fixedtypevaluesetfield, '$1','$2','$3'}. - -TypeOptionalitySpec -> 'DEFAULT' Type : {'DEFAULT','$2'}. -TypeOptionalitySpec -> 'OPTIONAL' : 'OPTIONAL'. -TypeOptionalitySpec -> '$empty' : 'MANDATORY'. - -ValueOrObjectOptSpec -> ValueOptionalitySpec : '$1'. -ValueOrObjectOptSpec -> ObjectOptionalitySpec : '$1'. -ValueOrObjectOptSpec -> 'OPTIONAL' : 'OPTIONAL'. -ValueOrObjectOptSpec -> '$empty' : 'MANDATORY'. - -ValueOptionalitySpec -> 'DEFAULT' Value : - case '$2' of - {identifier,_,Id} -> {'DEFAULT',Id}; - _ -> {'DEFAULT','$2'} - end. - -%ObjectOptionalitySpec -> 'DEFAULT' Object :{'DEFAULT','$1'}. -ObjectOptionalitySpec -> 'DEFAULT' '{' FieldSetting ',' FieldSettings '}' : - {'DEFAULT',{object,['$2'|'$4']}}. -ObjectOptionalitySpec -> 'DEFAULT' '{' FieldSetting '}' : - {'DEFAULT',{object, ['$2']}}. -%ObjectOptionalitySpec -> 'DEFAULT' '{' DefinedSyntaxTokens '}' : -% {'DEFAULT',{object, '$2'}}. -ObjectOptionalitySpec -> 'DEFAULT' ObjectFromObject : - {'DEFAULT',{object, '$2'}}. - - -VSetOrOSetOptSpec -> ValueSetOptionalitySpec : '$1'. -%VSetOrOSetOptSpec -> ObjectSetOptionalitySpec : '$1'. -VSetOrOSetOptSpec -> 'OPTIONAL' : 'OPTIONAL'. -VSetOrOSetOptSpec -> '$empty' : 'MANDATORY'. - -ValueSetOptionalitySpec -> 'DEFAULT' ValueSet : {'DEFAULT','$1'}. - -%ObjectSetOptionalitySpec -> 'DEFAULT' ObjectSet : {'DEFAULT','$1'}. - -OptionalitySpec -> 'DEFAULT' Type : {'DEFAULT','$2'}. -OptionalitySpec -> 'DEFAULT' ValueNotNull : - case '$2' of - {identifier,_,Id} -> {'DEFAULT',Id}; - _ -> {'DEFAULT','$2'} - end. -OptionalitySpec -> 'OPTIONAL' : 'OPTIONAL'. -OptionalitySpec -> '$empty' : 'MANDATORY'. - -WithSyntaxSpec -> 'WITH' 'SYNTAX' SyntaxList : {'WITH SYNTAX','$3'}. - -SyntaxList -> '{' TokenOrGroupSpecs '}' : '$2'. -SyntaxList -> '{' '}' : []. - -TokenOrGroupSpecs -> TokenOrGroupSpec : ['$1']. -TokenOrGroupSpecs -> TokenOrGroupSpec TokenOrGroupSpecs : ['$1'|'$2']. - -TokenOrGroupSpec -> RequiredToken : '$1'. -TokenOrGroupSpec -> OptionalGroup : '$1'. - -OptionalGroup -> '[' TokenOrGroupSpecs ']' : '$2'. - -RequiredToken -> typereference : '$1'. -RequiredToken -> Word : '$1'. -RequiredToken -> ',' : '$1'. -RequiredToken -> PrimitiveFieldName : '$1'. - -Word -> 'BY' : 'BY'. - -ParameterizedTypeAssignment -> typereference ParameterList '::=' Type : - #ptypedef{pos=element(2,'$1'),name=element(3,'$1'), - args='$2', typespec='$4'}. - -ParameterList -> '{' Parameters '}':'$2'. - -Parameters -> Parameter: ['$1']. -Parameters -> Parameter ',' Parameters: ['$1'|'$3']. - -Parameter -> typereference: '$1'. -Parameter -> Value: '$1'. -Parameter -> Type ':' typereference: {'$1','$3'}. -Parameter -> Type ':' Value: {'$1','$3'}. -Parameter -> '{' typereference '}': {objectset,'$2'}. - - -% Externaltypereference -> modulereference '.' typereference : {'$1','$3'} . -Externaltypereference -> typereference '.' typereference : #'Externaltypereference'{pos=element(2,'$1'),module=element(3,'$1'),type=element(3,'$3')}. - -% Externalvaluereference -> modulereference '.' valuereference : {'$1','$3'} . -% inlined Externalvaluereference -> typereference '.' identifier : #'Externalvaluereference'{pos=element(2,'$1'),module=element(3,'$1'),value=element(3,'$3')}. - - -DefinedType -> Externaltypereference : '$1' . -DefinedType -> typereference : - #'Externaltypereference'{pos='$1'#typereference.pos, - module= get(asn1_module), - type= '$1'#typereference.val} . -DefinedType -> typereference ParameterList : {pt,'$1','$2'}. -DefinedType -> Externaltypereference ParameterList : {pt,'$1','$2'}. - -% ActualParameterList -> '{' ActualParameters '}' : '$1'. - -% ActualParameters -> ActualParameter : ['$1']. -% ActualParameters -> ActualParameter ',' ActualParameters : ['$1'|'$3']. - -ActualParameter -> Type : '$1'. -ActualParameter -> ValueNotNull : '$1'. -ActualParameter -> ValueSet : '$1'. -% later DefinedType -> ParameterizedType : '$1' . -% later DefinedType -> ParameterizedValueSetType : '$1' . - -% inlined DefinedValue -> Externalvaluereference :'$1'. -% inlined DefinedValue -> identifier :'$1'. -% later DefinedValue -> ParameterizedValue :'$1'. - -% not referenced yet AbsoluteReference -> '@' GlobalModuleReference '.' ItemSpec :{'$2','$4'}. - -% not referenced yet ItemSpec -> typereference :'$1'. -% not referenced yet ItemSpec -> ItemId '.' ComponentId : {'$1','$3'}. - -% not referenced yet ItemId -> ItemSpec : '$1'. - -% not referenced yet ComponentId -> identifier :'$1'. -% not referenced yet ComponentId -> number :'$1'. -% not referenced yet ComponentId -> '*' :'$1'. - -TypeAssignment -> typereference '::=' Type : - #typedef{pos=element(2,'$1'),name=element(3,'$1'),typespec='$3'}. - -ValueAssignment -> identifier Type '::=' Value : - #valuedef{pos=element(2,'$1'),name=element(3,'$1'),type='$2',value='$4'}. - -% later ValueSetTypeAssignment -> typereference Type '::=' ValueSet :{'ValueSetTypeAssignment','$1','$2','$4'}. - - -ValueSet -> '{' ElementSetSpec '}' : {valueset,'$2'}. - -% record(type,{tag,def,constraint}). -Type -> BuiltinType :#type{def='$1'}. -Type -> 'NULL' :#type{def='NULL'}. -Type -> TaggedType:'$1'. -Type -> ReferencedType:#type{def='$1'}. % change notag later -Type -> ConstrainedType:'$1'. - -%ANY is here for compatibility with the old ASN.1 standard from 1988 -BuiltinType -> 'ANY' AnyDefBy: - case '$2' of - [] -> 'ANY'; - _ -> {'ANY DEFINED BY','$2'} - end. -BuiltinType -> BitStringType :'$1'. -BuiltinType -> 'BOOLEAN' :element(1,'$1'). -BuiltinType -> CharacterStringType :'$1'. -BuiltinType -> ChoiceType :'$1'. -BuiltinType -> 'EMBEDDED' 'PDV' :'EMBEDDED PDV'. -BuiltinType -> EnumeratedType :'$1'. -BuiltinType -> 'EXTERNAL' :element(1,'$1'). -% later BuiltinType -> InstanceOfType :'$1'. -BuiltinType -> IntegerType :'$1'. -% BuiltinType -> 'NULL' :element(1,'$1'). -% later BuiltinType -> ObjectClassFieldType :'$1'. -BuiltinType -> 'OBJECT' 'IDENTIFIER' :'OBJECT IDENTIFIER'. -BuiltinType -> 'OCTET' 'STRING' :'OCTET STRING'. -BuiltinType -> 'REAL' :element(1,'$1'). -BuiltinType -> SequenceType :'$1'. -BuiltinType -> SequenceOfType :'$1'. -BuiltinType -> SetType :'$1'. -BuiltinType -> SetOfType :'$1'. -% The so called Useful types -BuiltinType -> 'GeneralizedTime': 'GeneralizedTime'. -BuiltinType -> 'UTCTime' :'UTCTime'. -BuiltinType -> 'ObjectDescriptor' : 'ObjectDescriptor'. - -% moved BuiltinType -> TaggedType :'$1'. - - -AnyDefBy -> 'DEFINED' 'BY' identifier: '$3'. -AnyDefBy -> '$empty': []. - -NamedType -> identifier Type : -%{_,Pos,Val} = '$1', -%{'NamedType',Pos,{Val,'$2'}}. -V1 = '$1', -{'NamedType',V1#identifier.pos,{V1#identifier.val,'$2'}}. -NamedType -> SelectionType :'$1'. - -ReferencedType -> DefinedType : '$1'. -% redundant ReferencedType -> UsefulType : 'fix'. -ReferencedType -> SelectionType : '$1'. -ReferencedType -> TypeFromObject : '$1'. -% later ReferencedType -> ValueSetFromObjects : 'fix'. - -% to much conflicts Value -> AnyValue :'$1'. -Value -> ValueNotNull : '$1'. -Value -> 'NULL' :element(1,'$1'). - -ValueNotNull -> BuiltinValue :'$1'. -% inlined Value -> DefinedValue :'$1'. % DefinedValue , identifier -% inlined Externalvaluereference -> Externalvaluereference :'$1'. -ValueNotNull -> typereference '.' identifier : - #'Externalvaluereference'{pos=element(2,'$1'),module=element(3,'$1'), - value=element(3,'$3')}. -ValueNotNull -> identifier :'$1'. - - -%tmp Value -> NamedNumber: '$1'. % not a value but part of ObjIdC -% redundant BuiltinValue -> BitStringValue :'$1'. -BuiltinValue -> BooleanValue :'$1'. -BuiltinValue -> CharacterStringValue :'$1'. -BuiltinValue -> ChoiceValue :'$1'. -% BuiltinValue -> EmbeddedPDVValue :'$1'. ==SequenceValue -% BuiltinValue -> EnumeratedValue :'$1'. identifier -% BuiltinValue -> ExternalValue :'$1'. ==SequenceValue -% later BuiltinValue -> InstanceOfValue :'$1'. -BuiltinValue -> SignedNumber :'$1'. -% BuiltinValue -> 'NULL' :'$1'. -% later BuiltinValue -> ObjectClassFieldValue :'$1'. -% replaced by SAndSOfValue BuiltinValue -> ObjectIdentifierValue :'$1'. -BuiltinValue -> bstring :element(3,'$1'). -BuiltinValue -> hstring :element(3,'$1'). -% conflict BuiltinValue -> RealValue :'$1'. -BuiltinValue -> SAndSOfValue :'$1'. -% replaced BuiltinValue -> SequenceOfValue :'$1'. -% replaced BuiltinValue -> SequenceValue :'$1'. -% replaced BuiltinValue -> SetValue :'$1'. -% replaced BuiltinValue -> SetOfValue :'$1'. -% conflict redundant BuiltinValue -> TaggedValue :'$1'. - -% inlined ReferencedValue -> DefinedValue:'$1'. -% ReferencedValue -> Externalvaluereference:'$1'. -% ReferencedValue -> identifier :'$1'. -% later ReferencedValue -> ValueFromObject:'$1'. - -% inlined BooleanType -> BOOLEAN :'BOOLEAN'. - -% to much conflicts AnyValue -> Type ':' Value : {'ANYVALUE',{'$1','$3'}}. - -BooleanValue -> TRUE :true. -BooleanValue -> FALSE :false. - -IntegerType -> 'INTEGER' : 'INTEGER'. -IntegerType -> 'INTEGER' '{' NamedNumberList '}' : {'INTEGER','$3'}. - -NamedNumberList -> NamedNumber :['$1']. -% modified NamedNumberList -> NamedNumberList ',' NamedNumber :'fix'. -NamedNumberList -> NamedNumber ',' NamedNumberList :['$1'|'$3']. - -NamedNumber -> identifier '(' SignedNumber ')' : {'NamedNumber',element(3,'$1'),'$3'}. -NamedNumber -> identifier '(' typereference '.' identifier ')' : {'NamedNumber',element(3,'$1'),{'ExternalValue',element(3,'$3'),element(3,'$5')}}. -NamedNumber -> identifier '(' identifier ')' : {'NamedNumber',element(3,'$1'),element(3,'$3')}. - -%NamedValue -> identifier Value : -% {'NamedValue',element(2,'$1'),element(3,'$1'),'$2'}. - - -SignedNumber -> number : element(3,'$1'). -SignedNumber -> '-' number : - element(3,'$1'). - -% inlined IntegerValue -> SignedNumber :'$1'. -% conflict moved to Value IntegerValue -> identifier:'$1'. - -EnumeratedType -> ENUMERATED '{' Enumeration '}' :{'ENUMERATED','$3'}. - -% inlined Enumerations -> Enumeration :{'$1','false',[]}. -% inlined Enumerations -> Enumeration ',' '...' : {'$1','true',[]}. -% inlined Enumerations -> Enumeration ',' '...' ',' Enumeration : {'$1','true','$5'}. - -Enumeration -> EnumerationItem :['$1']. -% modified Enumeration -> EnumerationItem ',' Enumeration :'fix'. -Enumeration -> EnumerationItem ',' Enumeration :['$1'|'$3']. - -EnumerationItem -> identifier:element(3,'$1'). -EnumerationItem -> NamedNumber :'$1'. -EnumerationItem -> '...' :'EXTENSIONMARK'. - -% conflict moved to Value EnumeratedValue -> identifier:'$1'. - -% inlined RealType -> REAL:'REAL'. - -RealValue -> NumericRealValue :'$1'. -RealValue -> SpecialRealValue:'$1'. - -% ?? NumericRealValue -> number:'$1'. % number MUST BE '0' -NumericRealValue -> SAndSOfValue : '$1'. % Value of the associated sequence type - -SpecialRealValue -> 'PLUS-INFINITY' :'$1'. -SpecialRealValue -> 'MINUS-INFINITY' :'$1'. - -BitStringType -> 'BIT' 'STRING' :{'BIT STRING',[]}. -BitStringType -> 'BIT' 'STRING' '{' NamedNumberList '}' :{'BIT STRING','$4'}. -% NamedBitList replaced by NamedNumberList to reduce the grammar -% Must check later that all "numbers" are positive - -% inlined BitStringValue -> bstring:'$1'. -% inlined BitStringValue -> hstring:'$1'. -% redundant use SequenceValue BitStringValue -> '{' IdentifierList '}' :$2. -% redundant use SequenceValue BitStringValue -> '{' '}' :'fix'. - -IdentifierList -> identifier :[element(3,'$1')]. -% modified IdentifierList -> IdentifierList ',' identifier :'$1'. -IdentifierList -> identifier ',' IdentifierList :[element(3,'$1')|'$3']. - -% inlined OctetStringType -> 'OCTET' 'STRING' :'OCTET STRING'. - -% inlined OctetStringValue -> bstring:'$1'. -% inlined OctetStringValue -> hstring:'$1'. - -% inlined NullType -> 'NULL':'NULL'. - -% inlined NullValue -> NULL:'NULL'. - -% result is {'SEQUENCE',Optionals,Extensionmark,Componenttypelist}. -SequenceType -> SEQUENCE '{' ComponentTypeList '}' :{'SEQUENCE','$3'}. -% SequenceType -> SEQUENCE '{' ComponentTypeLists '}' :{'SEQUENCE','$3'}. -% SequenceType -> SEQUENCE '{' ExtensionAndException '}' :{'SEQUENCE','$3'}. -SequenceType -> SEQUENCE '{' '}' :{'SEQUENCE',[]}. - -% result is {RootComponentList,ExtensionAndException,AdditionalComponentTypeList}. -%ComponentTypeLists -> ComponentTypeList ',' ExtensionAndException :{'$1','$3',[]}. -%ComponentTypeLists -> ComponentTypeList :{'$1','false',[]}. -%ComponentTypeLists -> ComponentTypeList ',' ExtensionAndException -% ',' ComponentTypeList :{'$1','$3', '$5'}. -%ComponentTypeLists -> ExtensionAndException ',' ComponentTypeList :{[],'$1','$3'}. - -ComponentTypeList -> ComponentType :['$1']. -% modified below ComponentTypeList -> ComponentTypeList ',' ComponentType :'$1'. -ComponentTypeList -> ComponentType ',' ComponentTypeList :['$1'|'$3']. - -% -record('ComponentType',{pos,name,type,attrib}). -ComponentType -> '...' ExceptionSpec :{'EXTENSIONMARK',element(2,'$1'),'$2'}. -ComponentType -> NamedType : - {'NamedType',Pos,{Name,Type}} = '$1', - #'ComponentType'{pos=Pos,name=Name,typespec=Type,prop=mandatory}. -ComponentType -> NamedType 'OPTIONAL' : - {'NamedType',Pos,{Name,Type}} = '$1', - #'ComponentType'{pos=Pos,name=Name,typespec=Type,prop='OPTIONAL'}. -ComponentType -> NamedType 'DEFAULT' Value: - {'NamedType',Pos,{Name,Type}} = '$1', - #'ComponentType'{pos=Pos,name=Name,typespec=Type,prop={'DEFAULT','$3'}}. -ComponentType -> 'COMPONENTS' 'OF' Type :{'COMPONENTS OF','$3'}. - -% redundant ExtensionAndException -> '...' : extensionmark. -% ExtensionAndException -> '...' ExceptionSpec : {extensionmark,'$2'}. - -% replaced SequenceValue -> '{' ComponentValueList '}':'$2'. -% replaced SequenceValue -> '{' '}':[]. - -ValueList -> Value :['$1']. -ValueList -> NamedNumber :['$1']. -% modified ValueList -> ValueList ',' Value :'$1'. -ValueList -> Value ',' ValueList :['$1'|'$3']. -ValueList -> Value ',' '...' :['$1' |[]]. -ValueList -> Value ValueList : ['$1',space|'$2']. -ValueList -> NamedNumber ValueList: ['$1',space|'$2']. - -%ComponentValueList -> identifier ObjIdComponent:[{'NamedValue','$1','$2'}]. -%ComponentValueList -> NamedValue :['$1']. -%ComponentValueList -> NamedValue ',' ComponentValueList:['$1'|'$3']. -%ComponentValueList -> identifier ObjIdComponent ',' ComponentValueList :[{'NamedValue', '$1','$2'}|'$4']. - -SequenceOfType -> SEQUENCE OF Type : {'SEQUENCE OF','$3'}. - -% replaced SequenceOfValue with SAndSOfValue - -SAndSOfValue -> '{' ValueList '}' :'$2'. -%SAndSOfValue -> '{' ComponentValueList '}' :'$2'. -SAndSOfValue -> '{' '}' :[]. - -% save for later SetType -> -% result is {'SET',Optionals,Extensionmark,Componenttypelist}. -SetType -> SET '{' ComponentTypeList '}' :{'SET','$3'}. -% SetType -> SET '{' ExtensionAndException '}' :{'SET','$3'}. -SetType -> SET '{' '}' :{'SET',[]}. - -% replaced SetValue with SAndSOfValue - -SetOfType -> SET OF Type : {'SET OF','$3'}. - -% replaced SetOfValue with SAndSOfValue - -ChoiceType -> 'CHOICE' '{' ComponentTypeList '}' :{'CHOICE','$3'}. -% AlternativeTypeList is replaced by ComponentTypeList -ChoiceValue -> identifier ':' Value : {'ChoiceValue',element(3,'$1'),'$3'}. -% save for later SelectionType -> - -TaggedType -> Tag Type : '$2'#type{tag=['$1'#tag{type={default,get(tagdefault)}}]}. -TaggedType -> Tag IMPLICIT Type :'$3'#type{tag=['$1'#tag{type='IMPLICIT'}]}. -TaggedType -> Tag EXPLICIT Type :'$3'#type{tag=['$1'#tag{type='EXPLICIT'}]}. - -Tag -> '[' Class ClassNumber ']': #tag{class='$2',number='$3'}. -Tag -> '[' Class typereference '.' identifier ']': - #tag{class='$2',number=#'Externalvaluereference'{pos=element(2,'$3'),module=element(3,'$3'), - value=element(3,'$5')}}. -Tag -> '[' Class number ']': #tag{class='$2',number=element(3,'$3')}. -Tag -> '[' Class identifier ']': #tag{class='$2',number=element(3,'$3')}. - -ClassNumber -> number :element(3,'$1'). -% inlined above ClassNumber -> typereference '.' identifier :{'Externalvaluereference',element(3,'$1'),element(3,'$3')}. -ClassNumber -> identifier :element(3,'$1'). - -Class -> 'UNIVERSAL' :element(1,'$1'). -Class -> 'APPLICATION' :element(1,'$1'). -Class -> 'PRIVATE' :element(1,'$1'). -Class -> '$empty' :'CONTEXT'. - -% conflict redundant TaggedValue -> Value:'$1'. - -% inlined EmbeddedPDVType -> 'EMBEDDED' 'PDV' :'EMBEDDED PDV'. - -% inlined EmbeddedPDVValue -> SequenceValue:'$1'. - -% inlined ExternalType -> 'EXTERNAL' :'EXTERNAL'. - -% inlined ExternalValue -> SequenceValue :'$1'. - -% inlined ObjectIdentifierType -> 'OBJECT' 'IDENTIFIER' :'OBJECT IDENTIFIER'. - -ObjectIdentifierValue -> '{' ObjIdComponentList '}' :'$2'. -% inlined ObjectIdentifierValue -> SequenceAndSequenceOfValue :'$1'. -% ObjectIdentifierValue -> '{' identifier ObjIdComponentList '}' :{'ObjectIdentifierValue','$2','$3'}. -% ObjectIdentifierValue -> '{' typereference '.' identifier ObjIdComponentList '}' :{'ObjectIdentifierValue',{'$2','$4'},'$5'}. - -ObjIdComponentList -> Value:'$1'. -ObjIdComponentList -> Value ObjIdComponentList :['$1'|'$2']. -%ObjIdComponentList -> DefinedValue:'$1'. -%ObjIdComponentList -> number:'$1'. -%ObjIdComponentList -> DefinedValue ObjIdComponentList :['$1'|'$2']. -%ObjIdComponentList -> number ObjIdComponentList :['$1'|'$2']. -%ObjIdComponentList -> ObjIdComponent ObjIdComponentList :['$1'|'$2']. -%ObjIdComponentList -> ObjIdComponent ObjIdComponentList :['$1'|'$2']. - -% redundant ObjIdComponent -> NameForm :'$1'. % expanded -% replaced by 2 ObjIdComponent -> NumberForm :'$1'. -% ObjIdComponent -> number :'$1'. -% ObjIdComponent -> DefinedValue :'$1'. % means DefinedValue -% ObjIdComponent -> NameAndNumberForm :'$1'. -% ObjIdComponent -> NamedNumber :'$1'. -% NamedBit replaced by NamedNumber to reduce grammar -% must check later that "number" is positive - -% NameForm -> identifier:'$1'. - -% inlined NumberForm -> number :'$1'. -% inlined NumberForm -> DefinedValue :'$1'. - -% replaced by NamedBit NameAndNumberForm -> identifier '(' NumberForm ')'. -% NameAndNumberForm -> NamedBit:'$1'. - - -CharacterStringType -> restrictedcharacterstringtype :element(3,'$1'). -CharacterStringType -> 'CHARACTER' 'STRING' :'CHARACTER STRING'. - -RestrictedCharacterStringValue -> cstring :element(3, '$1'). -% modified below RestrictedCharacterStringValue -> CharacterStringList :'$1'. -% conflict vs BuiltinValue RestrictedCharacterStringValue -> SequenceAndSequenceOfValue :'$1'. -RestrictedCharacterStringValue -> Quadruple :'$1'. -RestrictedCharacterStringValue -> Tuple :'$1'. - -% redundant CharacterStringList -> '{' ValueList '}' :'$2'. % modified - -% redundant CharSyms -> CharsDefn :'$1'. -% redundant CharSyms -> CharSyms ',' CharsDefn :['$1'|'$3']. - -% redundant CharsDefn -> cstring :'$1'. -% temporary replaced see below CharsDefn -> DefinedValue :'$1'. -% redundant CharsDefn -> Value :'$1'. - -Quadruple -> '{' number ',' number ',' number ',' number '}' :{'Quadruple','$2','$4','$6','$8'}. -% {Group,Plane,Row,Cell} - -Tuple -> '{' number ',' number '}' :{'Tuple', '$2','$4'}. -% {TableColumn,TableRow} - -% inlined UnrestrictedCharacterString -> 'CHARACTER' 'STRING' :'CHARACTER STRING'. - -CharacterStringValue -> RestrictedCharacterStringValue :'$1'. -% conflict vs BuiltinValue CharacterStringValue -> SequenceValue :'$1'. % UnrestrictedCharacterStringValue - -% inlined UsefulType -> typereference :'$1'. - -SelectionType -> identifier '<' Type : {'SelectionType',element(3,'$1'),'$3'}. - -ConstrainedType -> Type Constraint : - '$1'#type{constraint=merge_constraints(['$2'])}. -ConstrainedType -> Type Constraint Constraint : - '$1'#type{constraint=merge_constraints(['$2','$3'])}. -ConstrainedType -> Type Constraint Constraint Constraint: - '$1'#type{constraint=merge_constraints(['$2','$3','$4'])}. -ConstrainedType -> Type Constraint Constraint Constraint Constraint: - '$1'#type{constraint=merge_constraints(['$2','$3','$4','$5'])}. -%ConstrainedType -> Type Constraint :'$1'#type{constraint='$2'}. -%ConstrainedType -> Type Constraint :'$1'#type{constraint='$2'}. -ConstrainedType -> TypeWithConstraint :'$1'. - -TypeWithConstraint -> 'SET' Constraint 'OF' Type : - #type{def = {'SET OF','$4'},constraint=merge_constraints(['$2'])}. -TypeWithConstraint -> 'SET' 'SIZE' Constraint 'OF' Type : - #type{def = {'SET OF','$5'},constraint = merge_constraints([#constraint{c={'SizeConstraint','$3'#constraint.c}}])}. -TypeWithConstraint -> 'SEQUENCE' Constraint 'OF' Type : - #type{def = {'SEQUENCE OF','$4'},constraint = - merge_constraints(['$2'])}. -TypeWithConstraint -> 'SEQUENCE' 'SIZE' Constraint 'OF' Type : - #type{def = {'SEQUENCE OF','$5'},constraint = merge_constraints([#constraint{c={'SizeConstraint','$3'#constraint.c}}])}. - - -Constraint -> '(' ConstraintSpec ExceptionSpec ')' : - #constraint{c='$2',e='$3'}. - -% inlined Constraint -> SubTypeConstraint :'$1'. -ConstraintSpec -> ElementSetSpecs :'$1'. -ConstraintSpec -> UserDefinedConstraint :'$1'. -ConstraintSpec -> TableConstraint :'$1'. - -TableConstraint -> ComponentRelationConstraint : '$1'. -TableConstraint -> ObjectSet : '$1'. -%TableConstraint -> '{' typereference '}' :tableconstraint. - -ComponentRelationConstraint -> '{' typereference '}' '{' '@' ComponentIdList '}' : componentrelation. -ComponentRelationConstraint -> '{' typereference '}' '{' '@' '.' ComponentIdList '}' : componentrelation. - -ComponentIdList -> identifier: ['$1']. -ComponentIdList -> identifier '.' ComponentIdList: ['$1'| '$3']. - - -% later ConstraintSpec -> GeneralConstraint :'$1'. - -% from X.682 -UserDefinedConstraint -> 'CONSTRAINED' 'BY' '{' '}' : {constrained_by,[]}. -UserDefinedConstraint -> 'CONSTRAINED' 'BY' - '{' UserDefinedConstraintParameters '}' : {constrained_by,'$4'}. - -UserDefinedConstraintParameters -> UserDefinedConstraintParameter : ['$1']. -UserDefinedConstraintParameters -> - UserDefinedConstraintParameter ',' - UserDefinedConstraintParameters: ['$1'|'$3']. - -UserDefinedConstraintParameter -> Type '.' ActualParameter : {'$1','$3'}. -UserDefinedConstraintParameter -> ActualParameter : '$1'. - - - -ExceptionSpec -> '!' ExceptionIdentification : '$1'. -ExceptionSpec -> '$empty' : undefined. - -ExceptionIdentification -> SignedNumber : '$1'. -% inlined ExceptionIdentification -> DefinedValue : '$1'. -ExceptionIdentification -> typereference '.' identifier : - #'Externalvaluereference'{pos=element(2,'$1'),module=element(3,'$1'), - value=element(3,'$1')}. -ExceptionIdentification -> identifier :'$1'. -ExceptionIdentification -> Type ':' Value : {'$1','$3'}. - -% inlined SubTypeConstraint -> ElementSetSpec - -ElementSetSpecs -> ElementSetSpec : '$1'. -ElementSetSpecs -> ElementSetSpec ',' '...': {'$1',[]}. -ElementSetSpecs -> '...' ',' ElementSetSpec : {[],'$3'}. -ElementSetSpecs -> ElementSetSpec ',' '...' ',' ElementSetSpec : {'$1','$5'}. - -ElementSetSpec -> Unions : '$1'. -ElementSetSpec -> 'ALL' Exclusions : {'ALL','$2'}. - -Unions -> Intersections : '$1'. -Unions -> UElems UnionMark IntersectionElements : - case {'$1','$3'} of - {{'SingleValue',V1},{'SingleValue',V2}} -> - {'SingleValue',ordsets:union(to_set(V1),to_set(V2))} - end. - -UElems -> Unions :'$1'. - -Intersections -> IntersectionElements :'$1'. -Intersections -> IElems IntersectionMark IntersectionElements : - case {'$1','$3'} of - {{'SingleValue',V1},{'SingleValue',V2}} -> - {'SingleValue',ordsets:intersection(to_set(V1),to_set(V2))}; - {V1,V2} when list(V1) -> - V1 ++ [V2]; - {V1,V2} -> - [V1,V2] - end. -%Intersections -> IElems '^' IntersectionElements :{'INTERSECTION','$1','$3'}. -%Intersections -> IElems 'INTERSECTION' IntersectionElements :{'INTERSECTION','$1','$3'}. - -IElems -> Intersections :'$1'. - -IntersectionElements -> Elements :'$1'. -IntersectionElements -> Elems Exclusions :{'$1','$2'}. - -Elems -> Elements :'$1'. - -Exclusions -> 'EXCEPT' Elements :{'EXCEPT','$2'}. - -IntersectionMark -> 'INTERSECTION':'$1'. -IntersectionMark -> '^':'$1'. -UnionMark -> 'UNION':'$1'. -UnionMark -> '|':'$1'. - - -Elements -> SubTypeElements : '$1'. -%Elements -> ObjectSetElements : '$1'. -Elements -> '(' ElementSetSpec ')' : '$2'. -Elements -> ReferencedType : '$1'. - -SubTypeElements -> ValueList : {'SingleValue','$1'}. % NOTE it must be a Value -% The rule above modifyed only because of conflicts -SubTypeElements -> 'INCLUDES' Type : {'ContainedSubType','$2'}. -%not lalr1 if this is activated SubTypeElements -> Type : {'TypeConstraint','$1'}. -SubTypeElements -> LowerEndpoint '..' UpperEndpoint : {'ValueRange',{'$1','$3'}}. -SubTypeElements -> 'FROM' Constraint : {'PermittedAlphabet','$2'#constraint.c}. -SubTypeElements -> 'SIZE' Constraint: {'SizeConstraint','$2'#constraint.c}. -% later will introduce conflicts related to NULL SubTypeElements -> Type : {'TypeConstraint','$1'}. -SubTypeElements -> 'WITH' 'COMPONENT' Constraint:{'WITH COMPONENT','$3'}. -SubTypeElements -> 'WITH' 'COMPONENTS' '{' TypeConstraints '}':{'WITH COMPONENTS',{'FullSpecification','$4'}}. -SubTypeElements -> 'WITH' 'COMPONENTS' '{' '...' ',' TypeConstraints '}' :{'WITH COMPONENTS',{'PartialSpecification','$3'}}. - -% inlined above InnerTypeConstraints ::= -% inlined above SingleTypeConstraint::= Constraint -% inlined above MultipleTypeConstraints ::= FullSpecification | PartialSpecification -% inlined above FullSpecification ::= "{" TypeConstraints "}" -% inlined above PartialSpecification ::= "{" "..." "," TypeConstraints "}" -% TypeConstraints -> identifier : [{'NamedConstraint',element(3,'$1'),undefined,undefined}]. % is this really meaningful or allowed -TypeConstraints -> NamedConstraint : ['$1']. -TypeConstraints -> NamedConstraint ',' TypeConstraints : ['$1'|'$3']. -TypeConstraints -> identifier : ['$1']. -TypeConstraints -> identifier ',' TypeConstraints : ['$1'|'$3']. - -NamedConstraint -> identifier Constraint PresenceConstraint :{'NamedConstraint',element(3,'$1'),'$2','$3'}. -NamedConstraint -> identifier Constraint :{'NamedConstraint',element(3,'$1'),'$2',undefined}. -NamedConstraint -> identifier PresenceConstraint :{'NamedConstraint',element(3,'$1'),undefined,'$2'}. - -PresenceConstraint -> 'PRESENT' : 'PRESENT'. -PresenceConstraint -> 'ABSENT' : 'ABSENT'. -PresenceConstraint -> 'OPTIONAL' : 'OPTIONAL'. - - - -LowerEndpoint -> LowerEndValue :'$1'. -%LowerEndpoint -> LowerEndValue '<':{gt,'$1'}. -LowerEndpoint -> LowerEndValue '<':('$1'+1). - -UpperEndpoint -> UpperEndValue :'$1'. -%UpperEndpoint -> '<' UpperEndValue :{lt,'$2'}. -UpperEndpoint -> '<' UpperEndValue :('$2'-1). - -LowerEndValue -> Value :'$1'. -LowerEndValue -> 'MIN' :'MIN'. - -UpperEndValue -> Value :'$1'. -UpperEndValue -> 'MAX' :'MAX'. - - -% X.681 - - -% X.681 chap 15 - -%TypeFromObject -> ReferencedObjects '.' FieldName : {'$1','$3'}. -TypeFromObject -> typereference '.' FieldName : {'$1','$3'}. - -ReferencedObjects -> typereference : '$1'. -%ReferencedObjects -> ParameterizedObject -%ReferencedObjects -> DefinedObjectSet -%ReferencedObjects -> ParameterizedObjectSet - -FieldName -> typefieldreference : ['$1']. -FieldName -> valuefieldreference : ['$1']. -FieldName -> FieldName '.' FieldName : ['$1' | '$3']. - -PrimitiveFieldName -> typefieldreference : '$1'. -PrimitiveFieldName -> valuefieldreference : '$1'. - -%ObjectSetAssignment -> typereference DefinedObjectClass '::=' ObjectSet: null. -ObjectSetAssignment -> typereference typereference '::=' ObjectSet : - #typedef{pos=element(2,'$1'),name=element(3,'$1'),typespec={'ObjectSet',element(3,'$2'), '$4'}}. -ObjectSetAssignment -> typereference typereference '.' typereference '::=' ObjectSet. - -ObjectSet -> '{' ElementSetSpecs '}' : '$2'. -ObjectSet -> '{' '...' '}' : ['EXTENSIONMARK']. - -%ObjectSetElements -> Object. -% ObjectSetElements -> identifier : '$1'. -%ObjectSetElements -> DefinedObjectSet. -%ObjectSetElements -> ObjectSetFromObjects. -%ObjectSetElements -> ParameterizedObjectSet. - -%ObjectAssignment -> identifier DefinedObjectClass '::=' Object. -ObjectAssignment -> ValueAssignment. -%ObjectAssignment -> identifier typereference '::=' Object. -%ObjectAssignment -> identifier typereference '.' typereference '::=' Object. - -%Object -> DefinedObject: '$1'. -%Object -> ExternalObjectReference: '$1'.%Object -> DefinedObject: '$1'. -Object -> typereference '.' identifier: '$1'.%Object -> DefinedObject: '$1'. -Object -> identifier: '$1'.%Object -> DefinedObject: '$1'. - -%Object -> ObjectDefn -> DefaultSyntax: '$1'. -Object -> '{' FieldSetting ',' FieldSettings '}' : ['$2'|'$4']. -Object -> '{' FieldSetting '}' :['$2']. - -%% For User-friendly notation -%% Object -> ObjectDefn -> DefinedSyntax -Object -> '{' '}'. -Object -> '{' DefinedSyntaxTokens '}'. - -% later Object -> ParameterizedObject: '$1'. look in x.683 - -%DefinedObject -> ExternalObjectReference: '$1'. -%DefinedObject -> identifier: '$1'. - -DefinedObjectClass -> typereference. -%DefinedObjectClass -> objectclassreference. -DefinedObjectClass -> ExternalObjectClassReference. -%DefinedObjectClass -> typereference '.' objectclassreference. -%%DefinedObjectClass -> UsefulObjectClassReference. - -ExternalObjectReference -> typereference '.' identifier. -ExternalObjectClassReference -> typereference '.' typereference. -%%ExternalObjectClassReference -> typereference '.' objectclassreference. - -ObjectDefn -> DefaultSyntax: '$1'. -%ObjectDefn -> DefinedSyntax: '$1'. - -ObjectFromObject -> ReferencedObjects '.' FieldName : {'ObjectFromObject','$1','$3'}. - -% later look in x.683 ParameterizedObject -> - -%DefaultSyntax -> '{' '}'. -%DefaultSyntax -> '{' FieldSettings '}': '$2'. -DefaultSyntax -> '{' FieldSetting ',' FieldSettings '}': '$2'. -DefaultSyntax -> '{' FieldSetting '}': '$2'. - -FieldSetting -> PrimitiveFieldName Setting: {'$1','$2'}. - -FieldSettings -> FieldSetting ',' FieldSettings: ['$1'|'$3']. -FieldSettings -> FieldSetting ',' FieldSettings: ['$1'|'$3']. -FieldSettings -> FieldSetting: '$1'. - -%DefinedSyntax -> '{' '}'. -DefinedSyntax -> '{' DefinedSyntaxTokens '}': '$2'. - -DefinedSyntaxTokens -> DefinedSyntaxToken: '$1'. -DefinedSyntaxTokens -> DefinedSyntaxToken DefinedSyntaxTokens: ['$1'|'$2']. - -% expanded DefinedSyntaxToken -> Literal: '$1'. -%DefinedSyntaxToken -> typereference: '$1'. -DefinedSyntaxToken -> word: '$1'. -DefinedSyntaxToken -> ',': '$1'. -DefinedSyntaxToken -> Setting: '$1'. -%DefinedSyntaxToken -> '$empty': nil . - -% Setting ::= Type|Value|ValueSet|Object|ObjectSet -Setting -> Type: '$1'. -%Setting -> Value: '$1'. -%Setting -> ValueNotNull: '$1'. -Setting -> BuiltinValue: '$1'. -Setting -> ValueSet: '$1'. -%Setting -> Object: '$1'. -%Setting -> ExternalObjectReference. -Setting -> typereference '.' identifier. -Setting -> identifier. -Setting -> ObjectDefn. - -Setting -> ObjectSet: '$1'. - - -Erlang code. -%%-author('kenneth@erix.ericsson.se'). --copyright('Copyright (c) 1991-99 Ericsson Telecom AB'). --vsn('$Revision: /main/release/1 $'). --include("asn1_records.hrl"). - -to_set(V) when list(V) -> - ordsets:list_to_set(V); -to_set(V) -> - ordsets:list_to_set([V]). - -merge_constraints({Rlist,ExtList}) -> % extensionmarker in constraint - {merge_constraints(Rlist,[],[]), - merge_constraints(ExtList,[],[])}; - -merge_constraints(Clist) -> - merge_constraints(Clist, [], []). - -merge_constraints([Ch|Ct],Cacc, Eacc) -> - NewEacc = case Ch#constraint.e of - undefined -> Eacc; - E -> [E|Eacc] - end, - merge_constraints(Ct,[fixup_constraint(Ch#constraint.c)|Cacc],NewEacc); - -merge_constraints([],Cacc,[]) -> - lists:flatten(Cacc); -merge_constraints([],Cacc,Eacc) -> - lists:flatten(Cacc) ++ [{'Errors',Eacc}]. - -fixup_constraint(C) -> - case C of - {'SingleValue',V} when list(V) -> - [C, - {'ValueRange',{lists:min(V),lists:max(V)}}]; - {'PermittedAlphabet',{'SingleValue',V}} when list(V) -> - V2 = {'SingleValue', - ordsets:list_to_set(lists:flatten(V))}, - {'PermittedAlphabet',V2}; - {'PermittedAlphabet',{'SingleValue',V}} -> - V2 = {'SingleValue',[V]}, - {'PermittedAlphabet',V2}; - {'SizeConstraint',Sc} -> - {'SizeConstraint',fixup_size_constraint(Sc)}; - - List when list(List) -> - [fixup_constraint(Xc)||Xc <- List]; - Other -> - Other - end. - -fixup_size_constraint({'ValueRange',{Lb,Ub}}) -> - {Lb,Ub}; -fixup_size_constraint({{'ValueRange',R},[]}) -> - {R,[]}; -fixup_size_constraint({[],{'ValueRange',R}}) -> - {[],R}; -fixup_size_constraint({{'ValueRange',R1},{'ValueRange',R2}}) -> - {R1,R2}; -fixup_size_constraint({'SingleValue',[Sv]}) -> - fixup_size_constraint({'SingleValue',Sv}); -fixup_size_constraint({'SingleValue',L}) when list(L) -> - ordsets:list_to_set(L); -fixup_size_constraint({'SingleValue',L}) -> - {L,L}; -fixup_size_constraint({C1,C2}) -> - {fixup_size_constraint(C1), fixup_size_constraint(C2)}. - - - - - - - - - - - - - -- cgit v1.2.3