diff options
Diffstat (limited to 'lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_check.erl')
| -rw-r--r-- | lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_check.erl | 5567 |
1 files changed, 0 insertions, 5567 deletions
diff --git a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_check.erl b/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_check.erl deleted file mode 100644 index 9da6611dba..0000000000 --- a/lib/dialyzer/test/r9c_tests_SUITE_data/src/asn1/asn1ct_check.erl +++ /dev/null @@ -1,5567 +0,0 @@ -%% ``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 via the world wide web 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 Utvecklings AB. -%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings -%% AB. All Rights Reserved.'' -%% -%% $Id: asn1ct_check.erl,v 1.1 2008/12/17 09:53:29 mikpe Exp $ -%% --module(asn1ct_check). - -%% Main Module for ASN.1 compile time functions - -%-compile(export_all). --export([check/2,storeindb/1]). --include("asn1_records.hrl"). -%%% The tag-number for universal types --define(N_BOOLEAN, 1). --define(N_INTEGER, 2). --define(N_BIT_STRING, 3). --define(N_OCTET_STRING, 4). --define(N_NULL, 5). --define(N_OBJECT_IDENTIFIER, 6). --define(N_OBJECT_DESCRIPTOR, 7). --define(N_EXTERNAL, 8). % constructed --define(N_INSTANCE_OF,8). --define(N_REAL, 9). --define(N_ENUMERATED, 10). --define(N_EMBEDDED_PDV, 11). % constructed --define(N_SEQUENCE, 16). --define(N_SET, 17). --define(N_NumericString, 18). --define(N_PrintableString, 19). --define(N_TeletexString, 20). --define(N_VideotexString, 21). --define(N_IA5String, 22). --define(N_UTCTime, 23). --define(N_GeneralizedTime, 24). --define(N_GraphicString, 25). --define(N_VisibleString, 26). --define(N_GeneralString, 27). --define(N_UniversalString, 28). --define(N_CHARACTER_STRING, 29). % constructed --define(N_BMPString, 30). - --define(TAG_PRIMITIVE(Num), - case S#state.erule of - ber_bin_v2 -> - #tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=0}; - _ -> [] - end). --define(TAG_CONSTRUCTED(Num), - case S#state.erule of - ber_bin_v2 -> - #tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=32}; - _ -> [] - end). - --record(newt,{type=unchanged,tag=unchanged,constraint=unchanged,inlined=no}). % used in check_type to update type and tag --record(newv,{type=unchanged,value=unchanged}). % used in check_value to update type and value - -check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) -> - %%Predicates used to filter errors - TupleIs = fun({T,_},T) -> true; - (_,_) -> false - end, - IsClass = fun(X) -> TupleIs(X,asn1_class) end, - IsObjSet = fun(X) -> TupleIs(X,objectsetdef) end, - IsPObjSet = fun(X) -> TupleIs(X,pobjectsetdef) end, - IsObject = fun(X) -> TupleIs(X,objectdef) end, - IsValueSet = fun(X) -> TupleIs(X,valueset) end, - Element2 = fun(X) -> element(2,X) end, - - _Perror = checkp(S,ParameterizedTypes,[]), % must do this before the templates are used - Terror = checkt(S,Types,[]), - - %% get parameterized object sets sent to checkt/3 - %% and update Terror - - {PObjSetNames1,Terror2} = filter_errors(IsPObjSet,Terror), - - Verror = checkv(S,Values ++ ObjectSets,[]), %value sets may be parsed as object sets - - %% get information object classes wrongly sent to checkt/3 - %% and update Terror2 - - {AddClasses,Terror3} = filter_errors(IsClass,Terror2), - - NewClasses = Classes++AddClasses, - - Cerror = checkc(S,NewClasses,[]), - - %% get object sets incorrectly sent to checkv/3 - %% and update Verror - - {ObjSetNames,Verror2} = filter_errors(IsObjSet,Verror), - - %% get parameterized object sets incorrectly sent to checkv/3 - %% and update Verror2 - - {PObjSetNames,Verror3} = filter_errors(IsPObjSet,Verror2), - - %% get objects incorrectly sent to checkv/3 - %% and update Verror3 - - {ObjectNames,Verror4} = filter_errors(IsObject,Verror3), - - NewObjects = Objects++ObjectNames, - NewObjectSets = ObjSetNames ++ PObjSetNames ++ PObjSetNames1, - - %% get value sets - %% and update Verror4 - - {ValueSetNames,Verror5} = filter_errors(IsValueSet,Verror4), - - asn1ct:create_ets_table(inlined_objects,[named_table]), - {Oerror,ExclO,ExclOS} = checko(S,NewObjects ++ - NewObjectSets, - [],[],[]), - InlinedObjTuples = ets:tab2list(inlined_objects), - InlinedObjects = lists:map(Element2,InlinedObjTuples), - ets:delete(inlined_objects), - - Exporterror = check_exports(S,S#state.module), - case {Terror3,Verror5,Cerror,Oerror,Exporterror} of - {[],[],[],[],[]} -> - ContextSwitchTs = context_switch_in_spec(), - InstanceOf = instance_of_in_spec(), - NewTypes = lists:subtract(Types,AddClasses) ++ ContextSwitchTs - ++ InstanceOf, - NewValues = lists:subtract(Values,PObjSetNames++ObjectNames++ - ValueSetNames), - {ok, - {NewTypes,NewValues,ParameterizedTypes, - NewClasses,NewObjects,NewObjectSets}, - {NewTypes,NewValues,ParameterizedTypes,NewClasses, - lists:subtract(NewObjects,ExclO)++InlinedObjects, - lists:subtract(NewObjectSets,ExclOS)}}; - _ ->{error,{asn1,lists:flatten([Terror3,Verror5,Cerror, - Oerror,Exporterror])}} - end. - -context_switch_in_spec() -> - L = [{external,'EXTERNAL'}, - {embedded_pdv,'EMBEDDED PDV'}, - {character_string,'CHARACTER STRING'}], - F = fun({T,TName},Acc) -> - case get(T) of - generate -> erase(T), - [TName|Acc]; - _ -> Acc - end - end, - lists:foldl(F,[],L). - -instance_of_in_spec() -> - case get(instance_of) of - generate -> - erase(instance_of), - ['INSTANCE OF']; - _ -> - [] - end. - -filter_errors(Pred,ErrorList) -> - Element2 = fun(X) -> element(2,X) end, - RemovedTupleElements = lists:filter(Pred,ErrorList), - RemovedNames = lists:map(Element2,RemovedTupleElements), - %% remove value set name tuples from Verror - RestErrors = lists:subtract(ErrorList,RemovedTupleElements), - {RemovedNames,RestErrors}. - - -check_exports(S,Module = #module{}) -> - case Module#module.exports of - {exports,[]} -> - []; - {exports,all} -> - []; - {exports,ExportList} when list(ExportList) -> - IsNotDefined = - fun(X) -> - case catch get_referenced_type(S,X) of - {error,{asn1,_}} -> - true; - _ -> false - 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 - end. - -checkt(S,[Name|T],Acc) -> - %%io:format("check_typedef:~p~n",[Name]), - Result = - case asn1_db:dbget(S#state.mname,Name) of - undefined -> - error({type,{internal_error,'???'},S}); - Type when record(Type,typedef) -> - NewS = S#state{type=Type,tname=Name}, - case catch(check_type(NewS,Type,Type#typedef.typespec)) of - {error,Reason} -> - error({type,Reason,NewS}); - {'EXIT',Reason} -> - error({type,{internal_error,Reason},NewS}); - {asn1_class,_ClassDef} -> - {asn1_class,Name}; - pobjectsetdef -> - {pobjectsetdef,Name}; - pvalueset -> - {pvalueset,Name}; - Ts -> - case Type#typedef.checked of - true -> % already checked and updated - ok; - _ -> - NewTypeDef = Type#typedef{checked=true,typespec = Ts}, - %io:format("checkt:dbput:~p, ~p~n",[S#state.mname,NewTypeDef#typedef.name]), - asn1_db:dbput(NewS#state.mname,Name,NewTypeDef), % update the type - ok - end - end - end, - case Result of - ok -> - checkt(S,T,Acc); - _ -> - checkt(S,T,[Result|Acc]) - end; -checkt(S,[],Acc) -> - case check_contextswitchingtypes(S,[]) of - [] -> - lists:reverse(Acc); - L -> - checkt(S,L,Acc) - end. - -check_contextswitchingtypes(S,Acc) -> - CSTList=[{external,'EXTERNAL'}, - {embedded_pdv,'EMBEDDED PDV'}, - {character_string,'CHARACTER STRING'}], - check_contextswitchingtypes(S,CSTList,Acc). - -check_contextswitchingtypes(S,[{T,TName}|Ts],Acc) -> - case get(T) of - unchecked -> - put(T,generate), - check_contextswitchingtypes(S,Ts,[TName|Acc]); - _ -> - check_contextswitchingtypes(S,Ts,Acc) - end; -check_contextswitchingtypes(_,[],Acc) -> - Acc. - -checkv(S,[Name|T],Acc) -> - %%io:format("check_valuedef:~p~n",[Name]), - Result = case asn1_db:dbget(S#state.mname,Name) of - undefined -> error({value,{internal_error,'???'},S}); - Value when record(Value,valuedef); - record(Value,typedef); %Value set may be parsed as object set. - record(Value,pvaluedef); - record(Value,pvaluesetdef) -> - NewS = S#state{value=Value}, - case catch(check_value(NewS,Value)) of - {error,Reason} -> - error({value,Reason,NewS}); - {'EXIT',Reason} -> - error({value,{internal_error,Reason},NewS}); - {pobjectsetdef} -> - {pobjectsetdef,Name}; - {objectsetdef} -> - {objectsetdef,Name}; - {objectdef} -> - %% this is an object, save as typedef - #valuedef{checked=C,pos=Pos,name=N,type=Type, - value=Def}=Value, -% Currmod = S#state.mname, -% #type{def= -% #'Externaltypereference'{module=Mod, -% type=CName}} = Type, - ClassName = - Type#type.def, -% case Mod of -% Currmod -> -% {objectclassname,CName}; -% _ -> -% {objectclassname,Mod,CName} -% end, - NewSpec = #'Object'{classname=ClassName, - def=Def}, - NewDef = #typedef{checked=C,pos=Pos,name=N, - typespec=NewSpec}, - asn1_db:dbput(NewS#state.mname,Name,NewDef), - {objectdef,Name}; - {valueset,VSet} -> - Pos = asn1ct:get_pos_of_def(Value), - CheckedVSDef = #typedef{checked=true,pos=Pos, - name=Name,typespec=VSet}, - asn1_db:dbput(NewS#state.mname,Name,CheckedVSDef), - {valueset,Name}; - V -> - %% update the valuedef - asn1_db:dbput(NewS#state.mname,Name,V), - ok - end - end, - case Result of - ok -> - checkv(S,T,Acc); - _ -> - checkv(S,T,[Result|Acc]) - end; -checkv(_S,[],Acc) -> - lists:reverse(Acc). - - -checkp(S,[Name|T],Acc) -> - %io:format("check_ptypedef:~p~n",[Name]), - Result = case asn1_db:dbget(S#state.mname,Name) of - undefined -> - error({type,{internal_error,'???'},S}); - Type when record(Type,ptypedef) -> - NewS = S#state{type=Type,tname=Name}, - case catch(check_ptype(NewS,Type,Type#ptypedef.typespec)) of - {error,Reason} -> - error({type,Reason,NewS}); - {'EXIT',Reason} -> - error({type,{internal_error,Reason},NewS}); - {asn1_class,_ClassDef} -> - {asn1_class,Name}; - Ts -> - NewType = Type#ptypedef{checked=true,typespec = Ts}, - asn1_db:dbput(NewS#state.mname,Name,NewType), % update the type - ok - end - end, - case Result of - ok -> - checkp(S,T,Acc); - _ -> - checkp(S,T,[Result|Acc]) - end; -checkp(_S,[],Acc) -> - lists:reverse(Acc). - - - - -checkc(S,[Name|Cs],Acc) -> - Result = - case asn1_db:dbget(S#state.mname,Name) of - undefined -> - error({class,{internal_error,'???'},S}); - Class -> - ClassSpec = if - record(Class,classdef) -> - Class#classdef.typespec; - record(Class,typedef) -> - Class#typedef.typespec - end, - NewS = S#state{type=Class,tname=Name}, - case catch(check_class(NewS,ClassSpec)) of - {error,Reason} -> - error({class,Reason,NewS}); - {'EXIT',Reason} -> - error({class,{internal_error,Reason},NewS}); - C -> - %% update the classdef - NewClass = - if - record(Class,classdef) -> - Class#classdef{checked=true,typespec=C}; - record(Class,typedef) -> - #classdef{checked=true,name=Name,typespec=C} - end, - asn1_db:dbput(NewS#state.mname,Name,NewClass), - ok - end - end, - case Result of - ok -> - checkc(S,Cs,Acc); - _ -> - checkc(S,Cs,[Result|Acc]) - end; -checkc(_S,[],Acc) -> -%% include_default_class(S#state.mname), - lists:reverse(Acc). - -checko(S,[Name|Os],Acc,ExclO,ExclOS) -> - Result = - case asn1_db:dbget(S#state.mname,Name) of - undefined -> - error({type,{internal_error,'???'},S}); - Object when 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}); - {asn1,Reason} -> - error({type,Reason,NewS}); - O -> - NewObj = Object#typedef{checked=true,typespec=O}, - asn1_db:dbput(NewS#state.mname,Name,NewObj), - if - record(O,'Object') -> - case O#'Object'.gen of - true -> - {ok,ExclO,ExclOS}; - false -> - {ok,[Name|ExclO],ExclOS} - end; - record(O,'ObjectSet') -> - case O#'ObjectSet'.gen of - true -> - {ok,ExclO,ExclOS}; - false -> - {ok,ExclO,[Name|ExclOS]} - end - end - end; - PObject when 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}); - {asn1,Reason} -> - error({type,Reason,NewS}); - PO -> - NewPObj = PObject#pobjectdef{def=PO}, - asn1_db:dbput(NewS#state.mname,Name,NewPObj), - {ok,[Name|ExclO],ExclOS} - end; - PObjSet when 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}); - {asn1,Reason} -> - error({type,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) - end; -checko(_S,[],Acc,ExclO,ExclOS) -> - {lists:reverse(Acc),lists:reverse(ExclO),lists:reverse(ExclOS)}. - -check_class(S,CDef=#classdef{checked=Ch,name=Name,typespec=TS}) -> - case Ch of - true -> TS; - idle -> TS; - _ -> - NewCDef = CDef#classdef{checked=idle}, - asn1_db:dbput(S#state.mname,Name,NewCDef), - CheckedTS = check_class(S,TS), - asn1_db:dbput(S#state.mname,Name, - NewCDef#classdef{checked=true, - typespec=CheckedTS}), - CheckedTS - end; -check_class(S = #state{mname=M,tname=T},ClassSpec) - when record(ClassSpec,type) -> - Def = ClassSpec#type.def, - case Def of - #'Externaltypereference'{module=M,type=T} -> - #objectclass{fields=Def}; % in case of recursive definitions - Tref when record(Tref,'Externaltypereference') -> - {_,RefType} = get_referenced_type(S,Tref), -% case RefType of -% RefClass when record(RefClass,classdef) -> -% check_class(S,RefClass#classdef.typespec) -% end - case is_class(S,RefType) of - true -> - check_class(S,get_class_def(S,RefType)); - _ -> - error({class,{internal_error,RefType},S}) - end - end; -% check_class(S,{objectclassname,ModuleName,ClassName}) when atom(ModuleName),atom(ClassName) -> -% 'fix this'; -check_class(S,C) when record(C,objectclass) -> - NewFieldSpec = check_class_fields(S,C#objectclass.fields), - C#objectclass{fields=NewFieldSpec}; -%check_class(S,{objectclassname,ClassName}) -> -check_class(S,ClassName) -> - {_,Def} = get_referenced_type(S,ClassName), - case Def of - ClassDef when record(ClassDef,classdef) -> - case ClassDef#classdef.checked of - true -> - ClassDef#classdef.typespec; - idle -> - ClassDef#classdef.typespec; - false -> - check_class(S,ClassDef#classdef.typespec) - end; - TypeDef when record(TypeDef,typedef) -> - %% this case may occur when a definition is a reference - %% to a class definition. - case TypeDef#typedef.typespec of - #type{def=Ext} when record(Ext,'Externaltypereference') -> - check_class(S,Ext) - end - end; -check_class(_S,{poc,_ObjSet,_Params}) -> - 'fix this later'. - -check_class_fields(S,Fields) -> - check_class_fields(S,Fields,[]). - -check_class_fields(S,[F|Fields],Acc) -> - NewField = - case element(1,F) of - fixedtypevaluefield -> - {_,Name,Type,Unique,OSpec} = F, - RefType = check_type(S,#typedef{typespec=Type},Type), - {fixedtypevaluefield,Name,RefType,Unique,OSpec}; - object_or_fixedtypevalue_field -> - {_,Name,Type,Unique,OSpec} = F, - Cat = - case asn1ct_gen:type(asn1ct_gen:get_inner(Type#type.def)) of - Def when record(Def,typereference); - record(Def,'Externaltypereference') -> - {_,D} = get_referenced_type(S,Def), - D; - {undefined,user} -> - %% neither of {primitive,bif} or {constructed,bif} -%% {_,D} = get_referenced_type(S,#typereference{val=Type#type.def}), - {_,D} = get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=Type#type.def}), - D; - _ -> - Type - end, - case Cat of - Class when record(Class,classdef) -> - {objectfield,Name,Type,Unique,OSpec}; - _ -> - RefType = check_type(S,#typedef{typespec=Type},Type), - {fixedtypevaluefield,Name,RefType,Unique,OSpec} - end; - objectset_or_fixedtypevalueset_field -> - {_,Name,Type,OSpec} = F, -%% RefType = check_type(S,#typedef{typespec=Type},Type), - RefType = - case (catch check_type(S,#typedef{typespec=Type},Type)) of - {asn1_class,_ClassDef} -> - case if_current_checked_type(S,Type) of - true -> - Type#type.def; - _ -> - check_class(S,Type) - end; - CheckedType when record(CheckedType,type) -> - CheckedType; - _ -> - error({class,"internal error, check_class_fields",S}) - end, - if - record(RefType,'Externaltypereference') -> - {objectsetfield,Name,Type,OSpec}; - record(RefType,classdef) -> - {objectsetfield,Name,Type,OSpec}; - record(RefType,objectclass) -> - {objectsetfield,Name,Type,OSpec}; - true -> - {fixedtypevaluesetfield,Name,RefType,OSpec} - end; - typefield -> - case F of - {TF,Name,{'DEFAULT',Type}} -> - {TF,Name,{'DEFAULT',check_type(S,#typedef{typespec=Type},Type)}}; - _ -> F - end; - _ -> F - end, - check_class_fields(S,Fields,[NewField|Acc]); -check_class_fields(_S,[],Acc) -> - lists:reverse(Acc). - -if_current_checked_type(S,#type{def=Def}) -> - CurrentCheckedName = S#state.tname, - MergedModules = S#state.inputmodules, - % CurrentCheckedModule = S#state.mname, - case Def of - #'Externaltypereference'{module=CurrentCheckedName, - type=CurrentCheckedName} -> - true; - #'Externaltypereference'{module=ModuleName, - type=CurrentCheckedName} -> - case MergedModules of - undefined -> - false; - _ -> - lists:member(ModuleName,MergedModules) - end; - _ -> - false - end. - - - -check_pobject(_S,PObject) when record(PObject,pobjectdef) -> - Def = PObject#pobjectdef.def, - Def. - - -check_pobjectset(S,PObjSet) -> - #pvaluesetdef{pos=Pos,name=Name,args=Args,type=Type, - valueset=ValueSet}=PObjSet, - {Mod,Def} = get_referenced_type(S,Type#type.def), - case Def of - #classdef{} -> - ClassName = #'Externaltypereference'{module=Mod, - type=Def#classdef.name}, - {valueset,Set} = ValueSet, -% ObjectSet = #'ObjectSet'{class={objectclassname,ClassName}, - ObjectSet = #'ObjectSet'{class=ClassName, - set=Set}, - #pobjectsetdef{pos=Pos,name=Name,args=Args,class=Type#type.def, - def=ObjectSet}; - _ -> - PObjSet - end. - -check_object(_S,ObjDef,ObjSpec) when (ObjDef#typedef.checked == true) -> - ObjSpec; -check_object(S,_ObjDef,#'Object'{classname=ClassRef,def=ObjectDef}) -> - {_,_ClassDef} = get_referenced_type(S,ClassRef), - NewClassRef = check_externaltypereference(S,ClassRef), - ClassDef = - case _ClassDef#classdef.checked of - false -> - #classdef{checked=true, - typespec=check_class(S,_ClassDef#classdef.typespec)}; - _ -> - _ClassDef - end, - NewObj = - case ObjectDef of - Def when tuple(Def), (element(1,Def)==object) -> - NewSettingList = check_objectdefn(S,Def,ClassDef), - #'Object'{def=NewSettingList}; -% Def when tuple(Def), (element(1,Def)=='ObjectFromObject') -> -% fixa; - {po,{object,DefObj},ArgsList} -> - {_,Object} = get_referenced_type(S,DefObj),%DefObj is a - %%#'Externalvaluereference' or a #'Externaltypereference' - %% Maybe this call should be catched and in case of an exception - %% an nonallocated parameterized object should be returned. - instantiate_po(S,ClassDef,Object,ArgsList); - #'Externalvaluereference'{} -> - {_,Object} = get_referenced_type(S,ObjectDef), - check_object(S,Object,Object#typedef.typespec); - _ -> - exit({error,{no_object,ObjectDef},S}) - end, - Gen = gen_incl(S,NewObj#'Object'.def, - (ClassDef#classdef.typespec)#objectclass.fields), - NewObj#'Object'{classname=NewClassRef,gen=Gen}; - -%%check_object(S,ObjSetDef,ObjSet=#type{def={pt,ObjSetRef,Args}}) -> - %% A parameterized - -check_object(S, - _ObjSetDef, - ObjSet=#'ObjectSet'{class=ClassRef}) -> - {_,ClassDef} = get_referenced_type(S,ClassRef), - NewClassRef = check_externaltypereference(S,ClassRef), - UniqueFieldName = - case (catch get_unique_fieldname(ClassDef)) of - {error,'__undefined_'} -> {unique,undefined}; - {asn1,Msg,_} -> error({class,Msg,S}); - Other -> Other - end, - NewObjSet= - case ObjSet#'ObjectSet'.set of - {'SingleValue',Set} when list(Set) -> - CheckedSet = check_object_list(S,NewClassRef,Set), - NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName), - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, - set=NewSet}; - {'SingleValue',{definedvalue,ObjName}} -> - {_,ObjDef} = get_referenced_type(S,#identifier{val=ObjName}), - #'Object'{def=CheckedObj} = - check_object(S,ObjDef,ObjDef#typedef.typespec), - NewSet = get_unique_valuelist(S,[{ObjDef#typedef.name, - CheckedObj}], - UniqueFieldName), - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, - set=NewSet}; - {'SingleValue',#'Externalvaluereference'{value=ObjName}} -> - {_,ObjDef} = get_referenced_type(S,#identifier{val=ObjName}), - #'Object'{def=CheckedObj} = - check_object(S,ObjDef,ObjDef#typedef.typespec), - NewSet = get_unique_valuelist(S,[{ObjDef#typedef.name, - CheckedObj}], - UniqueFieldName), - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, - set=NewSet}; - ['EXTENSIONMARK'] -> - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, - set=['EXTENSIONMARK']}; - Set when list(Set) -> - CheckedSet = check_object_list(S,NewClassRef,Set), - NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName), - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, - set=NewSet}; - {Set,Ext} when list(Set) -> - CheckedSet = check_object_list(S,NewClassRef,Set++Ext), - NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName), - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, - set=NewSet++['EXTENSIONMARK']}; - {{'SingleValue',Set},Ext} -> - CheckedSet = check_object_list(S,NewClassRef, - merge_sets(Set,Ext)), - NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName), - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, - set=NewSet++['EXTENSIONMARK']}; - {Type,{'EXCEPT',Exclusion}} when 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), - instantiate_pos(S,ClassDef,PObjSetDef,ParamList); - {ObjDef={object,definedsyntax,_ObjFields},_Ext} -> - CheckedSet = check_object_list(S,NewClassRef,[ObjDef]), - NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName), - ObjSet#'ObjectSet'{uniquefname=UniqueFieldName, - set=NewSet++['EXTENSIONMARK']} - end, - Gen = gen_incl_set(S,NewObjSet#'ObjectSet'.set, - ClassDef), - NewObjSet#'ObjectSet'{class=NewClassRef,gen=Gen}. - - -merge_sets(Set,Ext) when list(Set),list(Ext) -> - Set ++ Ext; -merge_sets(Set,Ext) when list(Ext) -> - [Set|Ext]; -merge_sets(Set,{'SingleValue',Ext}) when list(Set) -> - Set ++ [Ext]; -merge_sets(Set,{'SingleValue',Ext}) -> - [Set] ++ [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 - 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) -> - case ObjOrSet of - ObjDef when 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_name,Def#'Object'.def}|Acc]); - {'SingleValue',{definedvalue,ObjName}} -> - {_,ObjectDef} = get_referenced_type(S,#identifier{val=ObjName}), - #'Object'{def=Def} = check_object(S,ObjectDef,ObjectDef#typedef.typespec), - check_object_list(S,ClassRef,Objs,[{ObjectDef#typedef.name,Def}|Acc]); - {'SingleValue',Ref = #'Externalvaluereference'{}} -> - {_,ObjectDef} = get_referenced_type(S,Ref), - #'Object'{def=Def} = check_object(S,ObjectDef,ObjectDef#typedef.typespec), - check_object_list(S,ClassRef,Objs,[{ObjectDef#typedef.name,Def}|Acc]); - ObjRef when record(ObjRef,'Externalvaluereference') -> - {_,ObjectDef} = get_referenced_type(S,ObjRef), - #'Object'{def=Def} = check_object(S,ObjectDef,ObjectDef#typedef.typespec), - check_object_list(S,ClassRef,Objs, -%% [{ObjRef#'Externalvaluereference'.value,Def}|Acc]); - [{ObjectDef#typedef.name,Def}|Acc]); - {'ValueFromObject',{_,Object},FieldName} -> - {_,Def} = get_referenced_type(S,Object), -%% TypeOrVal = get_fieldname_element(S,Def,FieldName);%% this must result in an object set - TypeDef = get_fieldname_element(S,Def,FieldName), - (TypeDef#typedef.typespec)#'ObjectSet'.set; - ObjSet when record(ObjSet,type) -> - ObjSetDef = - case ObjSet#type.def of - Ref when record(Ref,typereference); - 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); - Other -> - exit({error,{'unknown object',Other},S}) - 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). -%% case lists:member('EXTENSIONMARK',RevAcc) of -%% true -> -%% ExclRevAcc = lists:filter(fun(X)->X /= 'EXTENSIONMARK' end, -%% RevAcc), -%% ExclRevAcc ++ ['EXTENSIONMARK']; -%% false -> -%% RevAcc -%% 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 record(Def,typedef) -> - {_,_,ObjComps} = (Def#typedef.typespec)#'Object'.def, - case lists:keysearch(FieldName,1,ObjComps) of - {value,{_,TDef}} when record(TDef,typedef) -> - %% ORec = TDef#typedef.typespec, %% XXX This must be made general -% case TDef#typedef.typespec of -% ObjSetRec when record(ObjSetRec,'ObjectSet') -> -% ObjSet = ObjSetRec#'ObjectSet'.set; -% ObjRec when record(ObjRec,'Object') -> -% %% now get the field in ObjRec that RestFName points out -% %ObjRec -% TDef -% end; - TDef; - {value,{_,VDef}} when record(VDef,valuedef) -> - check_value(S,VDef); - _ -> - throw({assigned_object_error,"not_assigned_object",S}) - end; -get_fieldname_element(_S,Def,[{_RefType,_FieldName}|_RestFName]) - when record(Def,typedef) -> - ok. - -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,F}; - (V={_,_,_}) ->V end, ObjSet); -get_unique_valuelist(S,ObjSet,UFN) -> - get_unique_vlist(S,ObjSet,UFN,[]). - -get_unique_vlist(S,[],_,Acc) -> - case catch check_uniqueness(Acc) of - {asn1_error,_} -> -% exit({error,Reason,S}); - error({'ObjectSet',"not unique objects in object set",S}); - true -> - lists:reverse(Acc) - end; -get_unique_vlist(S,[{ObjName,Obj}|Rest],UniqueFieldName,Acc) -> - {_,_,Fields} = Obj, - VDef = get_unique_value(S,Fields,UniqueFieldName), - get_unique_vlist(S,Rest,UniqueFieldName, - [{ObjName,VDef#valuedef.value,Fields}|Acc]); -get_unique_vlist(S,[V={_,_,_}|Rest],UniqueFieldName,Acc) -> - get_unique_vlist(S,Rest,UniqueFieldName,[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 record(VDef,valuedef) -> - VDef; - {definedvalue,ValName} -> - ValueDef = asn1_db:dbget(Module,ValName), - case ValueDef of - VDef when record(VDef,valuedef) -> - ValueDef; - undefined -> - #valuedef{value=ValName} - end; - {'ValueFromObject',Object,Name} -> - case Object of - {object,Ext} when 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 atom(Value);number(Value) -> - #valuedef{value=Value}; - {'CHOICE',{_,Value}} when atom(Value);number(Value) -> - #valuedef{value=Value} - end; - false -> - exit({error,{'no unique value',Fields,UniqueFieldName},S}) -%% io:format("WARNING: no unique value in object"), -%% exit(uniqueFieldName) - 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, -%% ArgsList is the list of actual parameters -%% returns an #'Object' record. -instantiate_po(S,_ClassDef,Object,ArgsList) when record(Object,pobjectdef) -> - FormalParams = get_pt_args(Object), - MatchedArgs = match_args(FormalParams,ArgsList,[]), - NewS = S#state{type=Object,parameters=MatchedArgs}, - check_object(NewS,Object,#'Object'{classname=Object#pobjectdef.class, - def=Object#pobjectdef.def}). - -%% instantiate_pos/4 -%% ClassDef is the class of ObjectSetDef, -%% ObjectSetDef is the Parameterized object set, which is referenced -%% on the right side of the assignment, -%% ArgsList is the list of actual parameters, i.e. real objects -instantiate_pos(S,ClassDef,ObjectSetDef,ArgsList) -> - ClassName = ClassDef#classdef.name, - FormalParams = get_pt_args(ObjectSetDef), - Set = case get_pt_spec(ObjectSetDef) of - {valueset,_Set} -> _Set; - _Set -> _Set - end, - MatchedArgs = match_args(FormalParams,ArgsList,[]), - NewS = S#state{type=ObjectSetDef,parameters=MatchedArgs}, - check_object(NewS,ObjectSetDef, - #'ObjectSet'{class=name2Extref(S#state.mname,ClassName), - set=Set}). - - -%% gen_incl -> boolean() -%% If object with Fields has any of the corresponding class' typefields -%% then return value is true otherwise it is false. -%% If an object lacks a typefield but the class has a type field that -%% is OPTIONAL then we want gen to be true -gen_incl(S,{_,_,Fields},CFields)-> - gen_incl1(S,Fields,CFields). - -gen_incl1(_,_,[]) -> - false; -gen_incl1(S,Fields,[C|CFields]) -> - case element(1,C) of - typefield -> -% case lists:keymember(element(2,C),1,Fields) of -% true -> -% true; -% false -> -% gen_incl1(S,Fields,CFields) -% end; - true; %% should check that field is OPTIONAL or DEFUALT if - %% the object lacks this field - objectfield -> - case lists:keysearch(element(2,C),1,Fields) of - {value,Field} -> - Type = element(3,C), - {_,ClassDef} = get_referenced_type(S,Type#type.def), -% {_,ClassFields,_} = ClassDef#classdef.typespec, - #objectclass{fields=ClassFields} = - ClassDef#classdef.typespec, - ObjTDef = element(2,Field), - case gen_incl(S,(ObjTDef#typedef.typespec)#'Object'.def, - ClassFields) of - true -> - true; - _ -> - gen_incl1(S,Fields,CFields) - end; - _ -> - gen_incl1(S,Fields,CFields) - end; - _ -> - gen_incl1(S,Fields,CFields) - end. - -%% first if no unique field in the class return false.(don't generate code) -gen_incl_set(S,Fields,ClassDef) -> - case catch get_unique_fieldname(ClassDef) of - Tuple when tuple(Tuple) -> - false; - _ -> - gen_incl_set1(S,Fields, - (ClassDef#classdef.typespec)#objectclass.fields) - end. - -%% if any of the existing or potentially existing objects has a typefield -%% then return true. -gen_incl_set1(_,[],_CFields)-> - false; -gen_incl_set1(_,['EXTENSIONMARK'],_) -> - true; -%% Fields are the fields of an object in the object set. -%% CFields are the fields of the class of the object set. -gen_incl_set1(S,[Object|Rest],CFields)-> - Fields = element(size(Object),Object), - case gen_incl1(S,Fields,CFields) of - true -> - true; - false -> - gen_incl_set1(S,Rest,CFields) - end. - -check_objectdefn(S,Def,CDef) when record(CDef,classdef) -> - WithSyntax = (CDef#classdef.typespec)#objectclass.syntax, - ClassFields = (CDef#classdef.typespec)#objectclass.fields, - case Def of - {object,defaultsyntax,Fields} -> - 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 list(DefaultFields) -> - DefaultFields - end, - {object,defaultsyntax,NewFields}; - {object,_ObjectId} -> % This is a DefinedObject - fixa; - Other -> - exit({error,{objectdefn,Other}}) - end. - -check_defaultfields(S,Fields,ClassFields) -> - check_defaultfields(S,Fields,ClassFields,[]). - -check_defaultfields(_S,[],_ClassFields,Acc) -> - {object,defaultsyntax,lists:reverse(Acc)}; -check_defaultfields(S,[{FName,Spec}|Fields],ClassFields,Acc) -> - case lists:keysearch(FName,2,ClassFields) of - {value,CField} -> - NewField = convert_to_defaultfield(S,FName,Spec,CField), - check_defaultfields(S,Fields,ClassFields,[NewField|Acc]); - _ -> - throw({error,{asn1,{'unvalid field in object',FName}}}) - end. -%% {object,defaultsyntax,Fields}. - -convert_definedsyntax(_S,[],[],_ClassFields,Acc) -> - lists:reverse(Acc); -convert_definedsyntax(S,Fields,WithSyntax,ClassFields,Acc) -> - case match_field(S,Fields,WithSyntax,ClassFields) of - {MatchedField,RestFields,RestWS} -> - if - list(MatchedField) -> - convert_definedsyntax(S,RestFields,RestWS,ClassFields, - lists:append(MatchedField,Acc)); - true -> - convert_definedsyntax(S,RestFields,RestWS,ClassFields, - [MatchedField|Acc]) - end -%% throw({error,{asn1,{'unvalid syntax in object',WorS}}}) - end. - -match_field(S,Fields,WithSyntax,ClassFields) -> - match_field(S,Fields,WithSyntax,ClassFields,[]). - -match_field(S,Fields,[W|Ws],ClassFields,Acc) when 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 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 list(W) -> - case catch match_optional_field(S,Fields,W,ClassFields,[]) of - {'EXIT',_} -> - {Ret,Fields}; - {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], -match_optional_field(S,[{_,_,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); -%% identify and save field data -match_optional_field(S,[Setting|Rest],[{_,W}|Ws],ClassFields,Ret) -> - WorS = - case Setting of - Type when record(Type,type) -> Type; -%% #'Externalvaluereference'{value=WordOrSetting} -> WordOrSetting; - {'ValueFromObject',_,_} -> Setting; - {object,_,_} -> Setting; - {_,_,WordOrSetting} -> WordOrSetting; -%% Atom when atom(Atom) -> Atom - Other -> Other - end, - case lists:keysearch(W,2,ClassFields) of - false -> - throw({asn1,{optional_matcherror,WorS,W}}); - {value,CField} -> - NewField = convert_to_defaultfield(S,W,WorS,CField), - match_optional_field(S,Rest,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 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 list(W) -> -match_mandatory_field(_S,Fields,WithSyntax=[W|_Ws],_ClassFields,Acc) when list(W), length(Acc) >= 1 -> - {Acc,Fields,WithSyntax}; -%% identify and skip word -match_mandatory_field(S,[{_,_,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) -> - WorS = - case Setting of -%% Atom when atom(Atom) -> Atom; -%% #'Externalvaluereference'{value=WordOrSetting} -> WordOrSetting; - {object,_,_} -> Setting; - {_,_,WordOrSetting} -> WordOrSetting; - Type when record(Type,type) -> Type; - Other -> Other - end, - case lists:keysearch(W,2,ClassFields) of - false -> - throw({asn1,{mandatory_matcherror,WorS,W}}); - {value,CField} -> - NewField = convert_to_defaultfield(S,W,WorS,CField), - match_mandatory_field(S,Rest,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 -convert_to_defaultfield(S,ObjFieldName,ObjFieldSetting,CField)-> - CurrMod = S#state.mname, - case element(1,CField) of - typefield -> - TypeDef= - case ObjFieldSetting of - TypeRec when record(TypeRec,type) -> TypeRec#type.def; - TDef when record(TDef,typedef) -> - TDef#typedef{typespec=check_type(S,TDef, - TDef#typedef.typespec)}; - _ -> ObjFieldSetting - end, - Type = - if - record(TypeDef,typedef) -> TypeDef; - true -> - case asn1ct_gen:type(asn1ct_gen:get_inner(TypeDef)) of - ERef = #'Externaltypereference'{module=CurrMod} -> - {_,T} = get_referenced_type(S,ERef), - T#typedef{checked=true, - typespec=check_type(S,T, - T#typedef.typespec)}; - ERef = #'Externaltypereference'{module=ExtMod} -> - {_,T} = get_referenced_type(S,ERef), - #typedef{name=Name} = T, - check_type(S,T,T#typedef.typespec), - #typedef{checked=true, - name={ExtMod,Name}, - typespec=ERef}; - Bif when Bif=={primitive,bif};Bif=={constructed,bif} -> - T = check_type(S,#typedef{typespec=ObjFieldSetting}, - ObjFieldSetting), - #typedef{checked=true,name=Bif,typespec=T}; - _ -> - {Mod,T} = - %% get_referenced_type(S,#typereference{val=ObjFieldSetting}), - get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=ObjFieldSetting}), - case Mod of - CurrMod -> - T; - ExtMod -> - #typedef{name=Name} = T, - T#typedef{name={ExtMod,Name}} - end - end - end, - {ObjFieldName,Type}; - fixedtypevaluefield -> - case ObjFieldName of - Val when atom(Val) -> - %% ObjFieldSetting can be a value,an objectidentifiervalue, - %% an element in an enumeration or namednumberlist etc. - ValRef = - case ObjFieldSetting of - #'Externalvaluereference'{} -> ObjFieldSetting; - {'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); - #valuedef{} -> - ObjFieldSetting; - _ -> - #identifier{val=ObjFieldSetting} - end, - case ValRef of - #valuedef{} -> - {ObjFieldName,check_value(S,ValRef)}; - _ -> - ValDef = - case catch get_referenced_type(S,ValRef) of - {error,_} -> - check_value(S,#valuedef{name=Val, - type=element(3,CField), - value=ObjFieldSetting}); - {_,VDef} when record(VDef,valuedef) -> - check_value(S,VDef);%% XXX - {_,VDef} -> - check_value(S,#valuedef{name=Val, - type=element(3,CField), - value=VDef}) - end, - {ObjFieldName,ValDef} - end; - Val -> - {ObjFieldName,Val} - end; - fixedtypevaluesetfield -> - {ObjFieldName,ObjFieldSetting}; - objectfield -> - ObjectSpec = - case ObjFieldSetting of - Ref when record(Ref,typereference);record(Ref,identifier); - record(Ref,'Externaltypereference'); - record(Ref,'Externalvaluereference') -> - {_,R} = get_referenced_type(S,ObjFieldSetting), - R; - {'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); - %%ClassName = ObjFromObj#'Object'.classname, - %%#typedef{name=, - %% typespec= - %% ObjFromObj#'Object'{classname= - %% {objectclassname,ClassName}}}; - {object,_,_} -> - %% An object defined inlined in another object - #type{def=Ref} = element(3,CField), -% CRef = case Ref of -% #'Externaltypereference'{module=CurrMod, -% type=CName} -> -% CName; -% #'Externaltypereference'{module=ExtMod, -% type=CName} -> -% {ExtMod,CName} -% end, - InlinedObjName= - list_to_atom(lists:concat([S#state.tname]++ - ['_',ObjFieldName])), -% ObjSpec = #'Object'{classname={objectclassname,CRef}, - ObjSpec = #'Object'{classname=Ref, - def=ObjFieldSetting}, - CheckedObj= - check_object(S,#typedef{typespec=ObjSpec},ObjSpec), - InlObj = #typedef{checked=true,name=InlinedObjName, - typespec=CheckedObj}, - asn1ct_gen:insert_once(inlined_objects,{InlinedObjName, - InlinedObjName}), - asn1_db:dbput(S#state.mname,InlinedObjName,InlObj), - InlObj; - #type{def=Eref} when record(Eref,'Externaltypereference') -> - {_,R} = get_referenced_type(S,Eref), - R; - _ -> -%% {_,R} = get_referenced_type(S,#typereference{val=ObjFieldSetting}), - {_,R} = get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=ObjFieldSetting}), - R - end, - {ObjFieldName, - ObjectSpec#typedef{checked=true, - typespec=check_object(S,ObjectSpec, - ObjectSpec#typedef.typespec)}}; - variabletypevaluefield -> - {ObjFieldName,ObjFieldSetting}; - variabletypevaluesetfield -> - {ObjFieldName,ObjFieldSetting}; - objectsetfield -> - {_,ObjSetSpec} = - case ObjFieldSetting of - Ref when record(Ref,'Externaltypereference'); - record(Ref,'Externalvaluereference') -> - get_referenced_type(S,ObjFieldSetting); - ObjectList when 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 - {_,_,Type,_} = CField, - ClassDef = Type#type.def, - case ClassDef#'Externaltypereference'.module of - CurrMod -> - ClassDef#'Externaltypereference'.type; - ExtMod -> - {ExtMod, - ClassDef#'Externaltypereference'.type} - end, - {no_name, - #typedef{typespec= - #'ObjectSet'{class= -% {objectclassname,ClassRef}, - ClassDef, - set=ObjectList}}}; - ObjectSet={'SingleValue',_} -> - %% a Union of defined objects - {_,_,Type,_} = CField, - ClassDef = Type#type.def, -% ClassRef = -% case ClassDef#'Externaltypereference'.module of -% CurrMod -> -% ClassDef#'Externaltypereference'.type; -% ExtMod -> -% {ExtMod, -% ClassDef#'Externaltypereference'.type} -% end, - {no_name, -% #typedef{typespec=#'ObjectSet'{class={objectclassname,ClassRef}, - #typedef{typespec=#'ObjectSet'{class=ClassDef, - set=ObjectSet}}}; - {object,_,[#type{def={'TypeFromObject', - {object,RefedObj}, - FieldName}}]} -> - %% This case occurs when an ObjectSetFromObjects - %% production is used - {M,Def} = get_referenced_type(S,RefedObj), - {M,get_fieldname_element(S,Def,FieldName)}; - #type{def=Eref} when - record(Eref,'Externaltypereference') -> - get_referenced_type(S,Eref); - _ -> -%% get_referenced_type(S,#typereference{val=ObjFieldSetting}) - get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=ObjFieldSetting}) - end, - {ObjFieldName, - ObjSetSpec#typedef{checked=true, - typespec=check_object(S,ObjSetSpec, - ObjSetSpec#typedef.typespec)}} - end. - -check_value(OldS,V) when record(V,pvaluesetdef) -> - #pvaluesetdef{checked=Checked,type=Type} = V, - case Checked of - true -> V; - {error,_} -> V; - false -> - case get_referenced_type(OldS,Type#type.def) of - {_,Class} when record(Class,classdef) -> - throw({pobjectsetdef}); - _ -> continue - end - end; -check_value(_OldS,V) when record(V,pvaluedef) -> - %% Fix this case later - V; -check_value(OldS,V) when record(V,typedef) -> - %% This case when a value set has been parsed as an object set. - %% It may be a value set - #typedef{typespec=TS} = V, - case TS of - #'ObjectSet'{class=ClassRef} -> - {_,TSDef} = get_referenced_type(OldS,ClassRef), - %%IsObjectSet(TSDef); - case TSDef of - #classdef{} -> throw({objectsetdef}); - #typedef{typespec=#type{def=Eref}} when - record(Eref,'Externaltypereference') -> - %% This case if the class reference is a defined - %% reference to class - check_value(OldS,V#typedef{typespec=TS#'ObjectSet'{class=Eref}}); - #typedef{} -> - % 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}), - {valueset,Type#type{constraint=Value#valuedef.value}} - end; - _ -> - throw({objectsetdef}) - end; -check_value(S,#valuedef{pos=Pos,name=Name,type=Type, - value={valueset,Constr}}) -> - NewType = Type#type{constraint=[Constr]}, - {valueset, - check_type(S,#typedef{pos=Pos,name=Name,typespec=NewType},NewType)}; -check_value(OldS=#state{recordtopname=TopName},V) when record(V,valuedef) -> - #valuedef{name=Name,checked=Checked,type=Vtype,value=Value} = V, - case Checked of - true -> - V; - {error,_} -> - V; - false -> - Def = Vtype#type.def, - Constr = Vtype#type.constraint, - S = OldS#state{type=Vtype,tname=Def,value=V,vname=Name}, - NewDef = - case Def of - Ext when record(Ext,'Externaltypereference') -> - RecName = Ext#'Externaltypereference'.type, - {_,Type} = get_referenced_type(S,Ext), - %% If V isn't a value but an object Type is a #classdef{} - case Type of - #classdef{} -> - throw({objectdef}); - #typedef{} -> - case is_contextswitchtype(Type) of - true -> - #valuedef{value=CheckedVal}= - check_value(S,V#valuedef{type=Type#typedef.typespec}), - #newv{value=CheckedVal}; - _ -> - #valuedef{value=CheckedVal}= - check_value(S#state{recordtopname=[RecName|TopName]}, - V#valuedef{type=Type#typedef.typespec}), - #newv{value=CheckedVal} - end - end; - 'ANY' -> - throw({error,{asn1,{'cant check value of type',Def}}}); - 'INTEGER' -> - validate_integer(S,Value,[],Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - {'INTEGER',NamedNumberList} -> - validate_integer(S,Value,NamedNumberList,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - {'BIT STRING',NamedNumberList} -> - validate_bitstring(S,Value,NamedNumberList,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'NULL' -> - validate_null(S,Value,Constr), - #newv{}; - 'OBJECT IDENTIFIER' -> - validate_objectidentifier(S,Value,Constr), - #newv{value = normalize_value(S,Vtype,Value,[])}; - 'ObjectDescriptor' -> - validate_objectdescriptor(S,Value,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - {'ENUMERATED',NamedNumberList} -> - validate_enumerated(S,Value,NamedNumberList,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'BOOLEAN'-> - validate_boolean(S,Value,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'OCTET STRING' -> - validate_octetstring(S,Value,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'NumericString' -> - validate_restrictedstring(S,Value,Def,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'TeletexString' -> - validate_restrictedstring(S,Value,Def,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'VideotexString' -> - validate_restrictedstring(S,Value,Def,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'UTCTime' -> - #newv{value=normalize_value(S,Vtype,Value,[])}; -% exit({'cant check value of type' ,Def}); - 'GeneralizedTime' -> - #newv{value=normalize_value(S,Vtype,Value,[])}; -% exit({'cant check value of type' ,Def}); - 'GraphicString' -> - validate_restrictedstring(S,Value,Def,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'VisibleString' -> - validate_restrictedstring(S,Value,Def,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'GeneralString' -> - validate_restrictedstring(S,Value,Def,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'PrintableString' -> - validate_restrictedstring(S,Value,Def,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'IA5String' -> - validate_restrictedstring(S,Value,Def,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; - 'BMPString' -> - validate_restrictedstring(S,Value,Def,Constr), - #newv{value=normalize_value(S,Vtype,Value,[])}; -%% 'UniversalString' -> %added 6/12 -00 -%% #newv{value=validate_restrictedstring(S,Value,Def,Constr)}; - Seq when record(Seq,'SEQUENCE') -> - SeqVal = validate_sequence(S,Value, - Seq#'SEQUENCE'.components, - Constr), - #newv{value=normalize_value(S,Vtype,SeqVal,TopName)}; - {'SEQUENCE OF',Components} -> - validate_sequenceof(S,Value,Components,Constr), - #newv{value=normalize_value(S,Vtype,Value,TopName)}; - {'CHOICE',Components} -> - validate_choice(S,Value,Components,Constr), - #newv{value=normalize_value(S,Vtype,Value,TopName)}; - Set when record(Set,'SET') -> - validate_set(S,Value,Set#'SET'.components, - Constr), - #newv{value=normalize_value(S,Vtype,Value,TopName)}; - {'SET OF',Components} -> - validate_setof(S,Value,Components,Constr), - #newv{value=normalize_value(S,Vtype,Value,TopName)}; - Other -> - exit({'cant check value of type' ,Other}) - end, - case NewDef#newv.value of - unchanged -> - V#valuedef{checked=true,value=Value}; - ok -> - V#valuedef{checked=true,value=Value}; - {error,Reason} -> - V#valuedef{checked={error,Reason},value=Value}; - _V -> - V#valuedef{checked=true,value=_V} - end - end. - -is_contextswitchtype(#typedef{name='EXTERNAL'})-> - true; -is_contextswitchtype(#typedef{name='EMBEDDED PDV'}) -> - true; -is_contextswitchtype(#typedef{name='CHARACTER STRING'}) -> - true; -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}, - NamedNumberList,_Constr) -> - case lists:keysearch(Id,1,NamedNumberList) of - {value,_} -> ok; - false -> error({value,"unknown NamedNumber",S}) - end; -validate_integer(S,Id,NamedNumberList,_Constr) when atom(Id) -> - case lists:keysearch(Id,1,NamedNumberList) of - {value,_} -> ok; - false -> error({value,"unknown NamedNumber",S}) - end; -validate_integer(_S,Value,_NamedNumberList,Constr) when integer(Value) -> - check_integer_range(Value,Constr). - -check_integer_range(Int,Constr) when list(Constr) -> - NewConstr = [X || #constraint{c=X} <- Constr], - check_constr(Int,NewConstr); - -check_integer_range(_Int,_Constr) -> - %%io:format("~p~n",[Constr]), - ok. - -check_constr(Int,[{'ValueRange',Lb,Ub}|T]) when Int >= Lb, Int =< Ub -> - check_constr(Int,T); -check_constr(_Int,[]) -> - ok. - -validate_bitstring(_S,_Value,_NamedNumberList,_Constr) -> - ok. - -validate_null(_S,'NULL',_Constr) -> - ok. - -%%------------ -%% 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,L,_) -> - case is_space_list(L,[]) of - NewL when list(NewL) -> - case validate_objectidentifier1(S,NewL) of - NewL2 when list(NewL2) -> - list_to_tuple(NewL2); - Other -> Other - end; - {error,_} -> - error({value, "illegal OBJECT IDENTIFIER", S}) - end. - -validate_objectidentifier1(S, [Id|T]) when record(Id,'Externalvaluereference') -> - case catch get_referenced_type(S,Id) of - {_,V} when record(V,valuedef) -> - case check_value(S,V) of - #valuedef{type=#type{def='OBJECT IDENTIFIER'}, - checked=true,value=Value} when tuple(Value) -> - validate_objectid(S, T, lists:reverse(tuple_to_list(Value))); - _ -> - error({value, "illegal OBJECT IDENTIFIER", S}) - end; - _ -> - validate_objectid(S, [Id|T], []) - end; -validate_objectidentifier1(S,V) -> - validate_objectid(S,V,[]). - -validate_objectid(_, [], Acc) -> - lists:reverse(Acc); -validate_objectid(S, [Value|Vrest], Acc) when integer(Value) -> - validate_objectid(S, Vrest, [Value|Acc]); -validate_objectid(S, [{'NamedNumber',_Name,Value}|Vrest], Acc) - when integer(Value) -> - validate_objectid(S, Vrest, [Value|Acc]); -validate_objectid(S, [Id|Vrest], Acc) - when record(Id,'Externalvaluereference') -> - case catch get_referenced_type(S, Id) of - {_,V} when record(V,valuedef) -> - case check_value(S, V) of - #valuedef{checked=true,value=Value} when integer(Value) -> - validate_objectid(S, Vrest, [Value|Acc]); - _ -> - error({value, "illegal OBJECT IDENTIFIER", S}) - end; - _ -> - case reserved_objectid(Id#'Externalvaluereference'.value, Acc) of - Value when integer(Value) -> - validate_objectid(S, Vrest, [Value|Acc]); - false -> - error({value, "illegal OBJECT IDENTIFIER", S}) - end - end; -validate_objectid(S, [{Atom,Value}],[]) when atom(Atom),integer(Value) -> - %% this case when an OBJECT IDENTIFIER value has been parsed as a - %% SEQUENCE value - Rec = #'Externalvaluereference'{module=S#state.mname, - value=Atom}, - validate_objectidentifier1(S,[Rec,Value]); -validate_objectid(S, [{Atom,EVRef}],[]) - when atom(Atom),record(EVRef,'Externalvaluereference') -> - %% this case when an OBJECT IDENTIFIER value has been parsed as a - %% SEQUENCE value OTP-4354 - Rec = #'Externalvaluereference'{module=S#state.mname, - value=Atom}, - validate_objectidentifier1(S,[Rec,EVRef]); -validate_objectid(S, _V, _Acc) -> - error({value, "illegal OBJECT IDENTIFIER",S}). - - -%% ITU-T Rec. X.680 Annex B - D -reserved_objectid('itu-t',[]) -> 0; -reserved_objectid('ccitt',[]) -> 0; -%% arcs below "itu-t" -reserved_objectid('recommendation',[0]) -> 0; -reserved_objectid('question',[0]) -> 1; -reserved_objectid('administration',[0]) -> 2; -reserved_objectid('network-operator',[0]) -> 3; -reserved_objectid('identified-organization',[0]) -> 4; -%% arcs below "recommendation" -reserved_objectid('a',[0,0]) -> 1; -reserved_objectid('b',[0,0]) -> 2; -reserved_objectid('c',[0,0]) -> 3; -reserved_objectid('d',[0,0]) -> 4; -reserved_objectid('e',[0,0]) -> 5; -reserved_objectid('f',[0,0]) -> 6; -reserved_objectid('g',[0,0]) -> 7; -reserved_objectid('h',[0,0]) -> 8; -reserved_objectid('i',[0,0]) -> 9; -reserved_objectid('j',[0,0]) -> 10; -reserved_objectid('k',[0,0]) -> 11; -reserved_objectid('l',[0,0]) -> 12; -reserved_objectid('m',[0,0]) -> 13; -reserved_objectid('n',[0,0]) -> 14; -reserved_objectid('o',[0,0]) -> 15; -reserved_objectid('p',[0,0]) -> 16; -reserved_objectid('q',[0,0]) -> 17; -reserved_objectid('r',[0,0]) -> 18; -reserved_objectid('s',[0,0]) -> 19; -reserved_objectid('t',[0,0]) -> 20; -reserved_objectid('u',[0,0]) -> 21; -reserved_objectid('v',[0,0]) -> 22; -reserved_objectid('w',[0,0]) -> 23; -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; -reserved_objectid('member-body',[1]) -> 2; -reserved_objectid('identified-organization',[1]) -> 3; - -reserved_objectid('joint-iso-itu-t',[]) -> 2; -reserved_objectid('joint-iso-ccitt',[]) -> 2; - -reserved_objectid(_,_) -> false. - - - - - -validate_objectdescriptor(_S,_Value,_Constr) -> - ok. - -validate_enumerated(S,Id,NamedNumberList,_Constr) when atom(Id) -> - case lists:keysearch(Id,1,NamedNumberList) of - {value,_} -> ok; - false -> error({value,"unknown ENUMERATED",S}) - end; -validate_enumerated(S,{identifier,_Pos,Id},NamedNumberList,_Constr) -> - case lists:keysearch(Id,1,NamedNumberList) of - {value,_} -> ok; - false -> error({value,"unknown ENUMERATED",S}) - end; -validate_enumerated(S,#'Externalvaluereference'{value=Id}, - NamedNumberList,_Constr) -> - case lists:keysearch(Id,1,NamedNumberList) of - {value,_} -> ok; - false -> error({value,"unknown ENUMERATED",S}) - end. - -validate_boolean(_S,_Value,_Constr) -> - ok. - -validate_octetstring(_S,_Value,_Constr) -> - ok. - -validate_restrictedstring(_S,_Value,_Def,_Constr) -> - ok. - -validate_sequence(S=#state{type=Vtype},Value,_Components,_Constr) -> - case Vtype of - #type{tag=[{tag,'UNIVERSAL',8,'IMPLICIT',32}]} -> - %% this is an 'EXTERNAL' (or INSTANCE OF) - case Value of - [{identification,_}|_RestVal] -> - to_EXTERNAL1990(S,Value); - _ -> - Value - end; - _ -> - Value - end. - -validate_sequenceof(_S,_Value,_Components,_Constr) -> - ok. - -validate_choice(_S,_Value,_Components,_Constr) -> - ok. - -validate_set(_S,_Value,_Components,_Constr) -> - ok. - -validate_setof(_S,_Value,_Components,_Constr) -> - ok. - -to_EXTERNAL1990(S,[{identification,{'CHOICE',{syntax,Stx}}}|Rest]) -> - to_EXTERNAL1990(S,Rest,[{'direct-reference',Stx}]); -to_EXTERNAL1990(S,[{identification,{'CHOICE',{'presentation-context-id',I}}}|Rest]) -> - to_EXTERNAL1990(S,Rest,[{'indirect-reference',I}]); -to_EXTERNAL1990(S,[{identification,{'CHOICE',{'context-negotiation',[{_,PCid},{_,TrStx}]}}}|Rest]) -> - to_EXTERNAL1990(S,Rest,[{'indirect-reference',PCid},{'direct-reference',TrStx}]); -to_EXTERNAL1990(S,_) -> - error({value,"illegal value in EXTERNAL type",S}). - -to_EXTERNAL1990(S,[V={'data-value-descriptor',_}|Rest],Acc) -> - to_EXTERNAL1990(S,Rest,[V|Acc]); -to_EXTERNAL1990(_S,[{'data-value',Val}],Acc) -> - Encoding = {encoding,{'CHOICE',{'octet-aligned',Val}}}, - lists:reverse([Encoding|Acc]); -to_EXTERNAL1990(S,_,_) -> - error({value,"illegal value in EXTERNAL type",S}). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Functions to normalize the default values of SEQUENCE -%% and SET components into Erlang valid format -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -normalize_value(_,_,mandatory,_) -> - mandatory; -normalize_value(_,_,'OPTIONAL',_) -> - 'OPTIONAL'; -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(S,Value,CType); - {'BIT STRING',CType,_} -> - normalize_bitstring(S,Value,CType); - {'OCTET STRING',CType,_} -> - normalize_octetstring(S,Value,CType); - {'NULL',_CType,_} -> - %%normalize_null(Value); - 'NULL'; - {'OBJECT IDENTIFIER',_,_} -> - normalize_objectidentifier(S,Value); - {'ObjectDescriptor',_,_} -> - normalize_objectdescriptor(Value); - {'REAL',_,_} -> - normalize_real(Value); - {'ENUMERATED',CType,_} -> - normalize_enumerated(Value,CType); - {'CHOICE',CType,NewNameList} -> - normalize_choice(S,Value,CType,NewNameList); - {'SEQUENCE',CType,NewNameList} -> - normalize_sequence(S,Value,CType,NewNameList); - {'SEQUENCE OF',CType,NewNameList} -> - normalize_seqof(S,Value,CType,NewNameList); - {'SET',CType,NewNameList} -> - normalize_set(S,Value,CType,NewNameList); - {'SET OF',CType,NewNameList} -> - normalize_setof(S,Value,CType,NewNameList); - {restrictedstring,CType,_} -> - normalize_restrictedstring(S,Value,CType); - _ -> - io:format("WARNING: could not check default value ~p~n",[Value]), - Value - end; -normalize_value(S,Type,Val,NameList) -> - normalize_value(S,Type,{'DEFAULT',Val},NameList). - -normalize_boolean(S,{Name,Bool},CType) when atom(Name) -> - normalize_boolean(S,Bool,CType); -normalize_boolean(_,true,_) -> - true; -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_integer(_S,Int,_) when integer(Int) -> - Int; -normalize_integer(_S,{Name,Int},_) when atom(Name),integer(Int) -> - Int; -normalize_integer(S,{Name,Int=#'Externalvaluereference'{}}, - Type) when atom(Name) -> - normalize_integer(S,Int,Type); -normalize_integer(S,Int=#'Externalvaluereference'{value=Name},Type) -> - case Type of - NNL when list(NNL) -> - case lists:keysearch(Name,1,NNL) of - {value,{Name,Val}} -> - Val; - false -> - get_normalized_value(S,Int,Type, - fun normalize_integer/3,[]) - end; - _ -> - get_normalized_value(S,Int,Type,fun normalize_integer/3,[]) - end; -normalize_integer(_,Int,_) -> - exit({'Unknown INTEGER value',Int}). - -normalize_bitstring(S,Value,Type)-> - %% There are four different Erlang formats of BIT STRING: - %% 1 - a list of ones and zeros. - %% 2 - a list of atoms. - %% 3 - as an integer, for instance in hexadecimal form. - %% 4 - as a tuple {Unused, Binary} where Unused is an integer - %% and tells how many bits of Binary are unused. - %% - %% normalize_bitstring/3 transforms Value according to: - %% A to 3, - %% B to 1, - %% C to 1 or 3 - %% D to 2, - %% Value can be on format: - %% A - {hstring, String}, where String is a hexadecimal string. - %% B - {bstring, String}, where String is a string on bit format - %% C - #'Externalvaluereference'{value=V}, where V is a defined value - %% D - list of #'Externalvaluereference', where each value component - %% is an identifier corresponing to NamedBits in Type. - case Value of - {hstring,String} when list(String) -> - hstring_to_int(String); - {bstring,String} when list(String) -> - bstring_to_bitlist(String); - Rec when record(Rec,'Externalvaluereference') -> - get_normalized_value(S,Value,Type, - fun normalize_bitstring/3,[]); - RecList when list(RecList) -> - case Type of - NBL when list(NBL) -> - F = fun(#'Externalvaluereference'{value=Name}) -> - case lists:keysearch(Name,1,NBL) of - {value,{Name,_}} -> - Name; - Other -> - throw({error,Other}) - end; - (Other) -> - throw({error,Other}) - end, - case catch lists:map(F,RecList) of - {error,Reason} -> - io:format("WARNING: default value not " - "compatible with type definition ~p~n", - [Reason]), - Value; - NewList -> - NewList - end; - _ -> - io:format("WARNING: default value not " - "compatible with type definition ~p~n", - [RecList]), - Value - end; - {Name,String} when atom(Name) -> - normalize_bitstring(S,String,Type); - Other -> - io:format("WARNING: illegal default value ~p~n",[Other]), - Value - end. - -hstring_to_int(L) when list(L) -> - hstring_to_int(L,0). -hstring_to_int([H|T],Acc) when H >= $A, H =< $F -> - hstring_to_int(T,(Acc bsl 4) + (H - $A + 10) ) ; -hstring_to_int([H|T],Acc) when H >= $0, H =< $9 -> - hstring_to_int(T,(Acc bsl 4) + (H - $0)); -hstring_to_int([],Acc) -> - Acc. - -bstring_to_bitlist([H|T]) when H == $0; H == $1 -> - [H - $0 | bstring_to_bitlist(T)]; -bstring_to_bitlist([]) -> - []. - -%% normalize_octetstring/1 changes representation of input Value to a -%% list of octets. -%% Format of Value is one of: -%% {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) -> - case Value of - {bstring,String} -> - bstring_to_octetlist(String); - {hstring,String} -> - hstring_to_octetlist(String); - Rec when record(Rec,'Externalvaluereference') -> - get_normalized_value(S,Value,CType, - fun normalize_octetstring/3,[]); - {Name,String} when atom(Name) -> - normalize_octetstring(S,String,CType); - List when list(List) -> - %% check if list elements are valid octet values - lists:map(fun([])-> ok; - (H)when H > 255-> - io:format("WARNING: not legal octet value ~p in OCTET STRING, ~p~n",[H,List]); - (_)-> ok - end, List), - List; - Other -> - io:format("WARNING: unknown default value ~p~n",[Other]), - Value - end. - - -bstring_to_octetlist([]) -> - []; -bstring_to_octetlist([H|T]) when H == $0 ; H == $1 -> - bstring_to_octetlist(T,6,[(H - $0) bsl 7]). -bstring_to_octetlist([H|T],0,[Hacc|Tacc]) when H == $0; H == $1 -> - bstring_to_octetlist(T, 7, [0,Hacc + (H -$0)| Tacc]); -bstring_to_octetlist([H|T],BSL,[Hacc|Tacc]) when H == $0; H == $1 -> - bstring_to_octetlist(T, BSL-1, [Hacc + ((H - $0) bsl BSL)| Tacc]); -bstring_to_octetlist([],7,[0|Acc]) -> - lists:reverse(Acc); -bstring_to_octetlist([],_,Acc) -> - lists:reverse(Acc). - -hstring_to_octetlist([]) -> - []; -hstring_to_octetlist(L) -> - hstring_to_octetlist(L,4,[]). -hstring_to_octetlist([H|T],0,[Hacc|Tacc]) when H >= $A, H =< $F -> - hstring_to_octetlist(T,4,[Hacc + (H - $A + 10)|Tacc]); -hstring_to_octetlist([H|T],BSL,Acc) when H >= $A, H =< $F -> - hstring_to_octetlist(T,0,[(H - $A + 10) bsl BSL|Acc]); -hstring_to_octetlist([H|T],0,[Hacc|Tacc]) when H >= $0; H =< $9 -> - hstring_to_octetlist(T,4,[Hacc + (H - $0)|Tacc]); -hstring_to_octetlist([H|T],BSL,Acc) when H >= $0; H =< $9 -> - hstring_to_octetlist(T,0,[(H - $0) bsl BSL|Acc]); -hstring_to_octetlist([],_,Acc) -> - lists:reverse(Acc). - -normalize_objectidentifier(S,Value) -> - validate_objectidentifier(S,Value,[]). - -normalize_objectdescriptor(Value) -> - Value. - -normalize_real(Value) -> - Value. - -normalize_enumerated(#'Externalvaluereference'{value=V},CType) - when list(CType) -> - normalize_enumerated2(V,CType); -normalize_enumerated(Value,CType) when atom(Value),list(CType) -> - normalize_enumerated2(Value,CType); -normalize_enumerated({Name,EnumV},CType) when atom(Name) -> - normalize_enumerated(EnumV,CType); -normalize_enumerated(Value,{CType1,CType2}) when list(CType1), list(CType2)-> - normalize_enumerated(Value,CType1++CType2); -normalize_enumerated(V,CType) -> - io:format("WARNING: Enumerated unknown type ~p~n",[CType]), - V. -normalize_enumerated2(V,Enum) -> - case lists:keysearch(V,1,Enum) of - {value,{Val,_}} -> Val; - _ -> - io:format("WARNING: Enumerated value is not correct ~p~n",[V]), - V - end. - -normalize_choice(S,{'CHOICE',{C,V}},CType,NameList) when atom(C) -> - Value = - case V of - Rec when record(Rec,'Externalvaluereference') -> - get_normalized_value(S,V,CType, - fun normalize_choice/4, - [NameList]); - _ -> V - end, - case catch lists:keysearch(C,#'ComponentType'.name,CType) of - {value,#'ComponentType'{typespec=CT,name=Name}} -> - {C,normalize_value(S,CT,{'DEFAULT',Value}, - [Name|NameList])}; - Other -> - io:format("WARNING: Wrong format of type/value ~p/~p~n", - [Other,Value]), - {C,Value} - end; -normalize_choice(S,{'DEFAULT',ValueList},CType,NameList) -> - lists:map(fun(X)-> normalize_choice(S,X,CType,NameList) end, ValueList); -normalize_choice(S,Val=#'Externalvaluereference'{},CType,NameList) -> - {_,#valuedef{value=V}}=get_referenced_type(S,Val), - normalize_choice(S,{'CHOICE',V},CType,NameList); -% get_normalized_value(S,Val,CType,fun normalize_choice/4,[NameList]); -normalize_choice(S,{Name,ChoiceVal},CType,NameList) - when atom(Name) -> - normalize_choice(S,ChoiceVal,CType,NameList). - -normalize_sequence(S,{Name,Value},Components,NameList) - when atom(Name),list(Value) -> - normalize_sequence(S,Value,Components,NameList); -normalize_sequence(S,Value,Components,NameList) -> - normalized_record('SEQUENCE',S,Value,Components,NameList). - -normalize_set(S,{Name,Value},Components,NameList) - when atom(Name),list(Value) -> - normalized_record('SET',S,Value,Components,NameList); -normalize_set(S,Value,Components,NameList) -> - normalized_record('SET',S,Value,Components,NameList). - -normalized_record(SorS,S,Value,Components,NameList) -> - NewName = list_to_atom(asn1ct_gen:list2name(NameList)), - 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. - -normalize_seq_or_set(SorS,S,[{Cname,V}|Vs], - [#'ComponentType'{name=Cname,typespec=TS}|Cs], - NameList,Acc) -> - NewNameList = - case TS#type.def of - #'Externaltypereference'{type=TName} -> - [TName]; - _ -> [Cname|NameList] - 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], - [#'ComponentType'{prop='OPTIONAL'}|Cs], - NameList,Acc) -> - 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 = - case TS#type.def of - #'Externaltypereference'{type=TName} -> - [TName]; - _ -> [Cname2|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). -normalize_seq_or_set(SorS,S,[], - [#'ComponentType'{name=Name,typespec=TS, - prop={'DEFAULT',Value}}|Cs], - NameList,Acc) -> - NewNameList = - case TS#type.def of - #'Externaltypereference'{type=TName} -> - [TName]; - _ -> [Name|NameList] - end, - NVal = normalize_value(S,TS,{'DEFAULT',Value},NewNameList), - normalize_seq_or_set(SorS,S,[],Cs,NameList,[NVal|Acc]); -normalize_seq_or_set(SorS,S,[],[#'ComponentType'{prop='OPTIONAL'}|Cs], - NameList,Acc) -> - normalize_seq_or_set(SorS,S,[],Cs,NameList,[asn1_NOVALUE|Acc]); -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_seqof(S,Value,Type,NameList) -> - normalize_s_of('SEQUENCE OF',S,Value,Type,NameList). - -normalize_setof(S,Value,Type,NameList) -> - normalize_s_of('SET OF',S,Value,Type,NameList). - -normalize_s_of(SorS,S,Value,Type,NameList) when list(Value) -> - DefValueList = lists:map(fun(X) -> {'DEFAULT',X} end,Value), - Suffix = asn1ct_gen:constructed_suffix(SorS,Type), - Def = Type#type.def, - InnerType = asn1ct_gen:get_inner(Def), - WhatKind = asn1ct_gen:type(InnerType), - NewNameList = - case WhatKind of - {constructed,bif} -> - [Suffix|NameList]; - #'Externaltypereference'{type=Name} -> - [Name]; - _ -> [] - end, - NormFun = fun (X) -> normalize_value(S,Type,X, - NewNameList) end, - case catch lists:map(NormFun, DefValueList) of - List when list(List) -> - List; - _ -> - io:format("WARNING: ~p could not handle value ~p~n", - [SorS,Value]), - Value - end; -normalize_s_of(SorS,S,Value,Type,NameList) - when record(Value,'Externalvaluereference') -> - get_normalized_value(S,Value,Type,fun normalize_s_of/5, - [SorS,NameList]). -% case catch get_referenced_type(S,Value) of -% {_,#valuedef{value=V}} -> -% normalize_s_of(SorS,S,V,Type); -% {error,Reason} -> -% io:format("WARNING: ~p could not handle value ~p~n", -% [SorS,Value]), -% Value; -% {_,NewVal} -> -% normalize_s_of(SorS,S,NewVal,Type); -% _ -> -% io:format("WARNING: ~p could not handle value ~p~n", -% [SorS,Value]), -% Value -% end. - - -%% normalize_restrictedstring handles all format of restricted strings. -%% tuple case -normalize_restrictedstring(_S,[Int1,Int2],_) when integer(Int1),integer(Int2) -> - {Int1,Int2}; -%% quadruple case -normalize_restrictedstring(_S,[Int1,Int2,Int3,Int4],_) when integer(Int1), - integer(Int2), - integer(Int3), - integer(Int4) -> - {Int1,Int2,Int3,Int4}; -%% character string list case -normalize_restrictedstring(S,[H|T],CType) when list(H);tuple(H) -> - [normalize_restrictedstring(S,H,CType)|normalize_restrictedstring(S,T,CType)]; -%% character sting case -normalize_restrictedstring(_S,CString,_) when list(CString) -> - Fun = - fun(X) -> - if - $X =< 255, $X >= 0 -> - ok; - true -> - io:format("WARNING: illegal character in string" - " ~p~n",[X]) - end - end, - lists:foreach(Fun,CString), - CString; -%% definedvalue case or argument in a parameterized type -normalize_restrictedstring(S,ERef,CType) when record(ERef,'Externalvaluereference') -> - get_normalized_value(S,ERef,CType, - fun normalize_restrictedstring/3,[]); -%% -normalize_restrictedstring(S,{Name,Val},CType) when atom(Name) -> - normalize_restrictedstring(S,Val,CType). - - -get_normalized_value(S,Val,Type,Func,AddArg) -> - case catch get_referenced_type(S,Val) of - {_,#valuedef{type=_T,value=V}} -> - %% should check that Type and T equals - call_Func(S,V,Type,Func,AddArg); - {error,_} -> - io:format("WARNING: default value not " - "comparable ~p~n",[Val]), - Val; - {_,NewVal} -> - call_Func(S,NewVal,Type,Func,AddArg); - _ -> - io:format("WARNING: default value not " - "comparable ~p~n",[Val]), - Val - end. - -call_Func(S,Val,Type,Func,ArgList) -> - case ArgList of - [] -> - Func(S,Val,Type); - [LastArg] -> - Func(S,Val,Type,LastArg); - [Arg1,LastArg1] -> - Func(Arg1,S,Val,Type,LastArg1); - [Arg1,LastArg1,LastArg2] -> - Func(Arg1,S,Val,Type,LastArg1,LastArg2) - end. - - -get_canonic_type(S,Type,NameList) -> - {InnerType,NewType,NewNameList} = - case Type#type.def of - Name when atom(Name) -> - {Name,Type,NameList}; - Ref when record(Ref,'Externaltypereference') -> - {_,#typedef{name=Name,typespec=RefedType}} = - get_referenced_type(S,Ref), - get_canonic_type(S,RefedType,[Name]); - {Name,T} when atom(Name) -> - {Name,T,NameList}; - Seq when record(Seq,'SEQUENCE') -> - {'SEQUENCE',Seq#'SEQUENCE'.components,NameList}; - Set when record(Set,'SET') -> - {'SET',Set#'SET'.components,NameList} - end, - {asn1ct_gen:unify_if_string(InnerType),NewType,NewNameList}. - - - -check_ptype(_S,Type,Ts) when record(Ts,type) -> - %Tag = Ts#type.tag, - %Constr = Ts#type.constraint, - Def = Ts#type.def, - NewDef= - case Def of - Seq when record(Seq,'SEQUENCE') -> - #newt{type=Seq#'SEQUENCE'{pname=Type#ptypedef.name}}; - Set when record(Set,'SET') -> - #newt{type=Set#'SET'{pname=Type#ptypedef.name}}; - _Other -> - #newt{} - end, - Ts2 = case NewDef of - #newt{type=unchanged} -> - Ts; - #newt{type=TDef}-> - Ts#type{def=TDef} - end, - Ts2. - - -% check_type(S,Type,ObjSpec={{objectclassname,_},_}) -> -% check_class(S,ObjSpec); -check_type(_S,Type,Ts) when record(Type,typedef), - (Type#typedef.checked==true) -> - Ts; -check_type(_S,Type,Ts) when record(Type,typedef), - (Type#typedef.checked==idle) -> % the check is going on - Ts; -check_type(S=#state{recordtopname=TopName},Type,Ts) when record(Ts,type) -> - {Def,Tag,Constr} = - case match_parameters(Ts#type.def,S#state.parameters) of - #type{constraint=_Ctmp,def=Dtmp} -> - {Dtmp,Ts#type.tag,Ts#type.constraint}; - Dtmp -> - {Dtmp,Ts#type.tag,Ts#type.constraint} - end, - TempNewDef = #newt{type=Def,tag=Tag,constraint=Constr}, - TestFun = - fun(Tref) -> - {_,MaybeChoice} = get_referenced_type(S,Tref), - case catch((MaybeChoice#typedef.typespec)#type.def) of - {'CHOICE',_} -> - maybe_illicit_implicit_tag(choice,Tag); - 'ANY' -> - maybe_illicit_implicit_tag(open_type,Tag); - 'ANY DEFINED BY' -> - maybe_illicit_implicit_tag(open_type,Tag); - 'ASN1_OPEN_TYPE' -> - maybe_illicit_implicit_tag(open_type,Tag); - _ -> - Tag - end - end, - NewDef= - case Def of - Ext when record(Ext,'Externaltypereference') -> - {_,RefTypeDef} = get_referenced_type(S,Ext), -% case RefTypeDef of -% Class when record(Class,classdef) -> -% throw({asn1_class,Class}); -% _ -> ok -% end, - case is_class(S,RefTypeDef) of - true -> throw({asn1_class,RefTypeDef}); - _ -> ok - end, - Ct = TestFun(Ext), - RefType = -%case S#state.erule of -% ber_bin_v2 -> - case RefTypeDef#typedef.checked of - true -> - RefTypeDef#typedef.typespec; - _ -> - NewRefTypeDef1 = RefTypeDef#typedef{checked=idle}, - asn1_db:dbput(S#state.mname, - NewRefTypeDef1#typedef.name,NewRefTypeDef1), - RefType1 = - check_type(S,RefTypeDef,RefTypeDef#typedef.typespec), - NewRefTypeDef2 = - RefTypeDef#typedef{checked=true,typespec = RefType1}, - asn1_db:dbput(S#state.mname, - NewRefTypeDef2#typedef.name,NewRefTypeDef2), - %% update the type and mark as checked - RefType1 - end, -% _ -> RefTypeDef#typedef.typespec -% end, - - 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 - TempNewDef#newt{ - type= - RefType#type.def, - tag= - merge_tags(Ct,RefType#type.tag), - constraint= - merge_constraints(check_constraints(S,Constr), - RefType#type.constraint)}; - _ -> - %% Here we only expand the tags and keep the ext ref - - TempNewDef#newt{ - type= - check_externaltypereference(S,Ext), - tag = - case S#state.erule of - ber_bin_v2 -> - merge_tags(Ct,RefType#type.tag); - _ -> - Ct - end - } - end; - 'ANY' -> - Ct=maybe_illicit_implicit_tag(open_type,Tag), - TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct}; - {'ANY_DEFINED_BY',_} -> - Ct=maybe_illicit_implicit_tag(open_type,Tag), - TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct}; - 'INTEGER' -> - check_integer(S,[],Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_INTEGER))}; - - {'INTEGER',NamedNumberList} -> - TempNewDef#newt{type={'INTEGER',check_integer(S,NamedNumberList,Constr)}, - tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_INTEGER))}; - {'BIT STRING',NamedNumberList} -> - NewL = check_bitstring(S,NamedNumberList,Constr), -%% erlang:display({asn1ct_check,NamedNumberList,NewL}), - TempNewDef#newt{type={'BIT STRING',NewL}, - tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_BIT_STRING))}; - 'NULL' -> - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_NULL))}; - 'OBJECT IDENTIFIER' -> - check_objectidentifier(S,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER))}; - 'ObjectDescriptor' -> - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_OBJECT_DESCRIPTOR))}; - 'EXTERNAL' -> -%% AssociatedType = asn1_db:dbget(S#state.mname,'EXTERNAL'), -%% #newt{type=check_type(S,Type,AssociatedType)}; - put(external,unchecked), - TempNewDef#newt{type= - #'Externaltypereference'{module=S#state.mname, - type='EXTERNAL'}, - tag= - merge_tags(Tag,?TAG_CONSTRUCTED(?N_EXTERNAL))}; - {'INSTANCE OF',DefinedObjectClass,Constraint} -> - %% check that DefinedObjectClass is of TYPE-IDENTIFIER class - %% If Constraint is empty make it the general INSTANCE OF type - %% If Constraint is not empty make an inlined type - %% convert INSTANCE OF to the associated type - IOFDef=check_instance_of(S,DefinedObjectClass,Constraint), - TempNewDef#newt{type=IOFDef, - tag=merge_tags(Tag,?TAG_CONSTRUCTED(?N_INSTANCE_OF))}; - {'ENUMERATED',NamedNumberList} -> - TempNewDef#newt{type= - {'ENUMERATED', - check_enumerated(S,NamedNumberList,Constr)}, - tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_ENUMERATED))}; - 'EMBEDDED PDV' -> -% AssociatedType = asn1_db:dbget(S#state.mname,'EMBEDDED PDV'), -% CheckedType = check_type(S,Type, -% AssociatedType#typedef.typespec), - put(embedded_pdv,unchecked), - TempNewDef#newt{type= - #'Externaltypereference'{module=S#state.mname, - type='EMBEDDED PDV'}, - tag= - merge_tags(Tag,?TAG_CONSTRUCTED(?N_EMBEDDED_PDV))}; - 'BOOLEAN'-> - check_boolean(S,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_BOOLEAN))}; - 'OCTET STRING' -> - check_octetstring(S,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_OCTET_STRING))}; - 'NumericString' -> - check_restrictedstring(S,Def,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_NumericString))}; - 'TeletexString' -> - check_restrictedstring(S,Def,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_TeletexString))}; - 'VideotexString' -> - check_restrictedstring(S,Def,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_VideotexString))}; - 'UTCTime' -> - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_UTCTime))}; - 'GeneralizedTime' -> - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_GeneralizedTime))}; - 'GraphicString' -> - check_restrictedstring(S,Def,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_GraphicString))}; - 'VisibleString' -> - check_restrictedstring(S,Def,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_VisibleString))}; - 'GeneralString' -> - check_restrictedstring(S,Def,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_GeneralString))}; - 'PrintableString' -> - check_restrictedstring(S,Def,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_PrintableString))}; - 'IA5String' -> - check_restrictedstring(S,Def,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_IA5String))}; - 'BMPString' -> - check_restrictedstring(S,Def,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_BMPString))}; - 'UniversalString' -> - check_restrictedstring(S,Def,Constr), - TempNewDef#newt{tag= - merge_tags(Tag,?TAG_PRIMITIVE(?N_UniversalString))}; - 'CHARACTER STRING' -> -% AssociatedType = asn1_db:dbget(S#state.mname, -% 'CHARACTER STRING'), -% CheckedType = check_type(S,Type, -% AssociatedType#typedef.typespec), - put(character_string,unchecked), - TempNewDef#newt{type= - #'Externaltypereference'{module=S#state.mname, - type='CHARACTER STRING'}, - tag= - merge_tags(Tag,?TAG_CONSTRUCTED(?N_CHARACTER_STRING))}; - Seq when record(Seq,'SEQUENCE') -> - RecordName = - case TopName of - [] -> - [Type#typedef.name]; - _ -> - TopName - end, - {TableCInf,Components} = - check_sequence(S#state{recordtopname= - RecordName}, - Type,Seq#'SEQUENCE'.components), - TempNewDef#newt{type=Seq#'SEQUENCE'{tablecinf=TableCInf, - components=Components}, - tag= - merge_tags(Tag,?TAG_CONSTRUCTED(?N_SEQUENCE))}; - {'SEQUENCE OF',Components} -> - TempNewDef#newt{type={'SEQUENCE OF',check_sequenceof(S,Type,Components)}, - tag= - merge_tags(Tag,?TAG_CONSTRUCTED(?N_SEQUENCE))}; - {'CHOICE',Components} -> - Ct = maybe_illicit_implicit_tag(choice,Tag), - TempNewDef#newt{type={'CHOICE',check_choice(S,Type,Components)},tag=Ct}; - Set when record(Set,'SET') -> - RecordName= - case TopName of - [] -> - [Type#typedef.name]; - _ -> - TopName - end, - {Sorted,TableCInf,Components} = - check_set(S#state{recordtopname=RecordName}, - Type,Set#'SET'.components), - TempNewDef#newt{type=Set#'SET'{sorted=Sorted, - tablecinf=TableCInf, - components=Components}, - tag= - merge_tags(Tag,?TAG_CONSTRUCTED(?N_SET))}; - {'SET OF',Components} -> - 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 - {{typereference,_,'TYPE-IDENTIFIER'},[{typefieldreference,_,'Type'}]} -> - Ct=maybe_illicit_implicit_tag(open_type,Tag), - TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct}; - - {#'Externaltypereference'{type='TYPE-IDENTIFIER'}, - [{typefieldreference,_,'Type'}]} -> - Ct=maybe_illicit_implicit_tag(open_type,Tag), - TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct}; - - {pt,Ptype,ParaList} -> - %% Ptype might be a parameterized - type, object set or - %% value set. If it isn't a parameterized type notify the - %% calling function. - {_,Ptypedef} = get_referenced_type(S,Ptype), - notify_if_not_ptype(S,Ptypedef), - NewParaList = [match_parameters(TmpParam,S#state.parameters)|| - TmpParam <- ParaList], - Instance = instantiate_ptype(S,Ptypedef,NewParaList), - TempNewDef#newt{type=Instance#type.def, - tag=merge_tags(Tag,Instance#type.tag), - constraint=Instance#type.constraint, - inlined=yes}; - -% {ClRef,FieldRefList} when record(ClRef,'Externaltypereference') -> - OCFT=#'ObjectClassFieldType'{class=ClRef} -> - %% this case occures in a SEQUENCE when - %% the type of the component is a ObjectClassFieldType - ClassSpec = check_class(S,ClRef), - NewTypeDef = maybe_open_type(S,ClassSpec,OCFT,Constr), - InnerTag = get_innertag(S,NewTypeDef), - MergedTag = merge_tags(Tag,InnerTag), - Ct = - case is_open_type(NewTypeDef) of - true -> - maybe_illicit_implicit_tag(open_type,MergedTag); - _ -> - MergedTag - end, - TempNewDef#newt{type=NewTypeDef,tag=Ct}; - {valueset,Vtype} -> - TempNewDef#newt{type={valueset,check_type(S,Type,Vtype)}}; - Other -> - exit({'cant check' ,Other}) - end, - Ts2 = case NewDef of - #newt{type=unchanged} -> - Ts#type{def=Def}; - #newt{type=TDef}-> - Ts#type{def=TDef} - end, - NewTag = case NewDef of - #newt{tag=unchanged} -> - Tag; - #newt{tag=TT} -> - TT - end, - T3 = Ts2#type{tag = lists:map(fun(TempTag = #tag{type={default,TTx}}) -> - TempTag#tag{type=TTx}; - (Else) -> Else end, NewTag)}, - T4 = case NewDef of - #newt{constraint=unchanged} -> - T3#type{constraint=Constr}; - #newt{constraint=NewConstr} -> - T3#type{constraint=NewConstr} - end, - T5 = T4#type{inlined=NewDef#newt.inlined}, - T5#type{constraint=check_constraints(S,T5#type.constraint)}. - - -get_innertag(_S,#'ObjectClassFieldType'{type=Type}) -> - case Type of - #type{tag=Tag} -> Tag; - {fixedtypevaluefield,_,#type{tag=Tag}} -> Tag; - {TypeFieldName,_} when atom(TypeFieldName) -> []; - _ -> [] - end; -get_innertag(_S,_) -> - []. - -is_class(_S,#classdef{}) -> - true; -is_class(S,#typedef{typespec=#type{def=Eref}}) - when record(Eref,'Externaltypereference')-> - {_,NextDef} = get_referenced_type(S,Eref), - is_class(S,NextDef); -is_class(_,_) -> - false. - -get_class_def(_S,CD=#classdef{}) -> - CD; -get_class_def(S,#typedef{typespec=#type{def=Eref}}) - when record(Eref,'Externaltypereference') -> - {_,NextDef} = get_referenced_type(S,Eref), - get_class_def(S,NextDef). - -maybe_illicit_implicit_tag(Kind,Tag) -> - case Tag of - [#tag{type='IMPLICIT'}|_T] -> - throw({error,{asn1,{implicit_tag_before,Kind}}}); - [ChTag = #tag{type={default,_}}|T] -> - case Kind of - open_type -> - [ChTag#tag{type='EXPLICIT',form=32}|T]; %X.680 30.6c, X.690 8.14.2 - choice -> - [ChTag#tag{type='EXPLICIT',form=32}|T] % X.680 28.6 c, 30.6c - end; - _ -> - Tag % unchanged - end. - -%% maybe_open_type/2 -> {ClassSpec,FieldRefList} | 'ASN1_OPEN_TYPE' -%% if the FieldRefList points out a typefield and the class don't have -%% any UNIQUE field, so that a component relation constraint cannot specify -%% the type of a typefield, return 'ASN1_OPEN_TYPE', otherwise return -%% {ClassSpec,FieldRefList}. -maybe_open_type(S,ClassSpec=#objectclass{fields=Fs}, - OCFT=#'ObjectClassFieldType'{fieldname=FieldRefList}, - Constr) -> - Type = get_ObjectClassFieldType(S,Fs,FieldRefList), - FieldNames=get_referenced_fieldname(FieldRefList), - case lists:last(FieldRefList) of - {valuefieldreference,_} -> - OCFT#'ObjectClassFieldType'{class=ClassSpec, - fieldname=FieldNames, - type=Type}; - {typefieldreference,_} -> - case {catch get_unique_fieldname(#classdef{typespec=ClassSpec}), - asn1ct_gen:get_constraint(Constr,componentrelation)}of - {Tuple,_} when tuple(Tuple) -> - OCFT#'ObjectClassFieldType'{class=ClassSpec, - fieldname=FieldNames, - type='ASN1_OPEN_TYPE'}; - {_,no} -> - OCFT#'ObjectClassFieldType'{class=ClassSpec, - fieldname=FieldNames, - type='ASN1_OPEN_TYPE'}; - _ -> - OCFT#'ObjectClassFieldType'{class=ClassSpec, - fieldname=FieldNames, - type=Type} - end - end. - -is_open_type(#'ObjectClassFieldType'{type='ASN1_OPEN_TYPE'}) -> - true; -is_open_type(#'ObjectClassFieldType'{}) -> - false. - - -notify_if_not_ptype(S,#pvaluesetdef{type=Type}) -> - case Type#type.def of - Ref when record(Ref,'Externaltypereference') -> - case get_referenced_type(S,Ref) of - {_,#classdef{}} -> - throw(pobjectsetdef); - {_,#typedef{}} -> - throw(pvalueset) - end; - T when record(T,type) -> % this must be a value set - throw(pvalueset) - end; -notify_if_not_ptype(_S,#ptypedef{}) -> - ok. - -% fix me -instantiate_ptype(S,Ptypedef,ParaList) -> - #ptypedef{args=Args,typespec=Type} = Ptypedef, -% Args = get_pt_args(Ptypedef), -% Type = get_pt_spec(Ptypedef), - MatchedArgs = match_args(Args, ParaList, []), - NewS = S#state{type=Type,parameters=MatchedArgs,abscomppath=[]}, - %The abscomppath must be empty since a table constraint in a - %parameterized type only can refer to components within the type - check_type(NewS, Ptypedef, Type). - -get_pt_args(#ptypedef{args=Args}) -> - Args; -get_pt_args(#pvaluesetdef{args=Args}) -> - Args; -get_pt_args(#pvaluedef{args=Args}) -> - Args; -get_pt_args(#pobjectdef{args=Args}) -> - Args; -get_pt_args(#pobjectsetdef{args=Args}) -> - Args. - -get_pt_spec(#ptypedef{typespec=Type}) -> - Type; -get_pt_spec(#pvaluedef{value=Value}) -> - Value; -get_pt_spec(#pvaluesetdef{valueset=VS}) -> - VS; -get_pt_spec(#pobjectdef{def=Def}) -> - Def; -get_pt_spec(#pobjectsetdef{def=Def}) -> - Def. - - - -match_args([FormArg|Ft], [ActArg|At], Acc) -> - match_args(Ft, At, [{FormArg,ActArg}|Acc]); -match_args([], [], Acc) -> - lists:reverse(Acc); -match_args(_, _, _) -> - throw({error,{asn1,{wrong_number_of_arguments}}}). - -check_constraints(S,C) when list(C) -> - check_constraints(S, C, []); -check_constraints(S,C) when record(C,constraint) -> - check_constraints(S, C#constraint.c, []). - - -resolv_tuple_or_list(S,List) when 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)}. - -%%%----------------------------------------- -%% If the constraint value is a defined value the valuename -%% is replaced by the actual value -%% -resolv_value(S,Val) -> - case match_parameters(Val, S#state.parameters) of - Id -> % unchanged - resolv_value1(S,Id); - Other -> - resolv_value(S,Other) - end. - -resolv_value1(S = #state{mname=M,inputmodules=InpMods}, - V=#'Externalvaluereference'{pos=Pos,module=ExtM,value=Name}) -> - case ExtM of - M -> resolv_value2(S,M,Name,Pos); - _ -> - case lists:member(ExtM,InpMods) of - true -> - resolv_value2(S,M,Name,Pos); - false -> - V - end - end; -resolv_value1(S,{gt,V}) -> - case V of - Int when integer(Int) -> - V + 1; - #valuedef{value=Int} -> - 1 + resolv_value(S,Int); - Other -> - throw({error,{asn1,{undefined_type_or_value,Other}}}) - end; -resolv_value1(S,{lt,V}) -> - case V of - Int when integer(Int) -> - V - 1; - #valuedef{value=Int} -> - resolv_value(S,Int) - 1; - Other -> - throw({error,{asn1,{undefined_type_or_value,Other}}}) - 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' - {_,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; -% resolv_value1(S,{'ValueFromObject',{po,Object,Params},FieldName}) -> -% %% FieldName can hold either a fixed-type value or a variable-type value -% %% Object is a ParameterizedObject -resolv_value1(_,V) -> - V. - -resolv_value2(S,ModuleName,Name,Pos) -> - case asn1_db:dbget(ModuleName,Name) of - undefined -> - case imported(S,Name) of - {ok,Imodule} -> - {_,V2} = get_referenced(S,Imodule,Name,Pos), - V2#valuedef.value; - _ -> - throw({error,{asn1,{undefined_type_or_value,Name}}}) - end; - Val -> - Val#valuedef.value - end. - -check_constraints(S,[{'ContainedSubtype',Type} | Rest], Acc) -> - {_,CTDef} = get_referenced_type(S,Type#type.def), - CType = check_type(S,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) -> -% io:format("Acc: ~p~n",[Acc]), - C = constraint_merge(S,lists:reverse(Acc)), -% io:format("C: ~p~n",[C]), - lists:flatten(C). - - -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,Ext) when record(Ext,'Externaltypereference') -> - check_externaltypereference(S,Ext); - - -check_constraint(S,{'SizeConstraint',{Lb,Ub}}) - when list(Lb);tuple(Lb),size(Lb)==2 -> - case Lb of - #'Externalvaluereference'{} -> - check_constraint(S,{'SizeConstraint',{resolv_value(S,Lb),Ub}}); - _ -> - NewLb = range_check(resolv_tuple_or_list(S,Lb)), - NewUb = range_check(resolv_tuple_or_list(S,Ub)), - {'SizeConstraint',{NewLb,NewUb}} - end; -check_constraint(S,{'SizeConstraint',{Lb,Ub}}) -> - case {resolv_value(S,Lb),resolv_value(S,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,{'SizeConstraint',Lb}) -> - {'SizeConstraint',resolv_value(S,Lb)}; - -check_constraint(S,{'SingleValue', L}) when list(L) -> - F = fun(A) -> resolv_value(S,A) end, - {'SingleValue',lists:map(F,L)}; - -check_constraint(S,{'SingleValue', V}) when 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,{'ContainedSubtype',Type}) -> -%% #typedef{typespec=TSpec} = -%% check_type(S,S#state.tname,get_referenced_type(S,Type#type.def)), -%% [C] = TSpec#type.constraint, -%% C; - -check_constraint(S,{valueset,Type}) -> - {valueset,check_type(S,S#state.tname,Type)}; - -check_constraint(S,{simpletable,Type}) -> - OSName = (Type#type.def)#'Externaltypereference'.type, - C = match_parameters(Type#type.def,S#state.parameters), - case C of - #'Externaltypereference'{} -> - Type#type{def=check_externaltypereference(S,C)}, - {simpletable,OSName}; - _ -> - check_type(S,S#state.tname,Type), - {simpletable,OSName} - end; - -check_constraint(S,{componentrelation,{objectset,Opos,Objset},Id}) -> - %% Objset is an 'Externaltypereference' record, since Objset is - %% a DefinedObjectSet. - RealObjset = match_parameters(Objset,S#state.parameters), - Ext = check_externaltypereference(S,RealObjset), - {componentrelation,{objectset,Opos,Ext},Id}; - -check_constraint(S,Type) when record(Type,type) -> - #type{def=Def} = check_type(S,S#state.tname,Type), - Def; - -check_constraint(S,C) when 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]), - Any. - -%% 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(_S,C=[H])when tuple(H) -> - C; -constraint_merge(_S,[]) -> - []; -constraint_merge(S,C) -> - %% skip all extension but the last - C1 = filter_extensions(C), - %% perform all internal level intersections, intersections first - %% since they have precedence over unions - C2 = lists:map(fun(X)when list(X)->constraint_intersection(S,X); - (X) -> X end, - C1), - %% perform all internal level unions - C3 = lists:map(fun(X)when 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), - CminusSVs=ordsets:subtract(ordsets:from_list(C3),ordsets:from_list(SVs)), - % CminusSVsVRs = ordsets:subtract(ordsets:from_list(CminusSVs), -% ordsets:from_list(VRs)), - RestC = ordsets:subtract(ordsets:from_list(CminusSVs), - ordsets:from_list(SZs)), - %% get the least common combined constraint. That is the union of each - %% deep costraint and merge of single value and value range constraints - combine_constraints(S,CombSV,CombVR,CombSZ++RestC). - -%% 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 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,[A={'ValueRange',_},union,B={'ValueRange',_}|Rest],Acc) -> - AunionB = constraint_union_vr([A,B]), - constraint_union1(S,Rest,AunionB++Acc); -constraint_union1(S,[A={'SingleValue',_},union,B={'SingleValue',_}|Rest],Acc) -> - AunionB = constraint_union_sv(S,[A,B]), - constraint_union1(S,Rest,AunionB++Acc); -constraint_union1(S,[A={'SingleValue',_},union,B={'ValueRange',_}|Rest],Acc) -> - AunionB = union_sv_vr(S,A,B), - constraint_union1(S,Rest,AunionB++Acc); -constraint_union1(S,[A={'ValueRange',_},union,B={'SingleValue',_}|Rest],Acc) -> - AunionB = union_sv_vr(S,B,A), - constraint_union1(S,Rest,AunionB++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) -> - lists:reverse(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. - -%% REMOVE???? -%%constraint_union(S,VR,'ValueRange') -> -%% constraint_union_vr(VR). - -%% constraint_union_vr(VR) -%% VR = [{'ValueRange',{Lb,Ub}},...] -%% Lb = 'MIN' | integer() -%% Ub = 'MAX' | integer() -%% Returns if possible only one ValueRange tuple with a range that -%% is a union of all ranges in VR. -constraint_union_vr(VR) -> - %% Sort VR by Lb in first hand and by Ub in second hand - Fun=fun({_,{'MIN',_B1}},{_,{A2,_B2}}) when integer(A2)->true; - ({_,{A1,_B1}},{_,{'MAX',_B2}}) when integer(A1) -> true; - ({_,{A1,_B1}},{_,{A2,_B2}}) when integer(A1),integer(A2),A1<A2 -> true; - ({_,{A,B1}},{_,{A,B2}}) when B1=<B2->true; - (_,_)->false end, - constraint_union_vr(lists:usort(Fun,VR),[]). - -constraint_union_vr([],Acc) -> - lists:reverse(Acc); -constraint_union_vr([C|Rest],[]) -> - constraint_union_vr(Rest,[C]); -constraint_union_vr([{_,{Lb,Ub2}}|Rest],[{_,{Lb,_Ub1}}|Acc]) -> %Ub2 > Ub1 - constraint_union_vr(Rest,[{'ValueRange',{Lb,Ub2}}|Acc]); -constraint_union_vr([{_,{_,Ub}}|Rest],A=[{_,{_,Ub}}|_Acc]) -> - constraint_union_vr(Rest,A); -constraint_union_vr([{_,{Lb2,Ub2}}|Rest],[{_,{Lb1,Ub1}}|Acc]) when Lb2=<Ub1, - Ub2>Ub1-> - constraint_union_vr(Rest,[{'ValueRange',{Lb1,Ub2}}|Acc]); -constraint_union_vr([{_,{_,Ub2}}|Rest],A=[{_,{_,Ub1}}|_Acc]) when Ub2=<Ub1-> - constraint_union_vr(Rest,A); -constraint_union_vr([VR|Rest],Acc) -> - constraint_union_vr(Rest,[VR|Acc]). - -union_sv_vr(_S,[],B) -> - [B]; -union_sv_vr(_S,A,[]) -> - [A]; -union_sv_vr(_S,C1={'SingleValue',SV},C2={'ValueRange',VR={Lb,Ub}}) - when integer(SV) -> - case is_int_in_vr(SV,C2) of - true -> [C2]; - _ -> - case VR of - {'MIN',Ub} when SV==Ub+1 -> [{'ValueRange',{'MIN',SV}}]; - {Lb,'MAX'} when SV==Lb-1 -> [{'ValueRange',{SV,'MAX'}}]; - {Lb,Ub} when SV==Ub+1 -> [{'ValueRange',{Lb,SV}}]; - {Lb,Ub} when SV==Lb-1 -> [{'ValueRange',{SV,Ub}}]; - _ -> - [C1,C2] - end - end; -union_sv_vr(_S,C1={'SingleValue',SV},C2={'ValueRange',{_Lb,_Ub}}) - when list(SV) -> - case lists:filter(fun(X)->is_int_in_vr(X,C2) end,SV) of - [] -> [C2]; - L -> - case expand_vr(L,C2) of - {[],C3} -> [C3]; - {L,C2} -> [C1,C2]; - {[Val],C3} -> [{'SingleValue',Val},C3]; - {L2,C3} -> [{'SingleValue',L2},C3] - end - end. - -expand_vr(L,VR={_,{Lb,Ub}}) -> - case lower_Lb(L,Lb) of - false -> - case higher_Ub(L,Ub) of - false -> - {L,VR}; - {L1,UbNew} -> - expand_vr(L1,{'ValueRange',{Lb,UbNew}}) - end; - {L1,LbNew} -> - expand_vr(L1,{'ValueRange',{LbNew,Ub}}) - end. - -lower_Lb(_,'MIN') -> - false; -lower_Lb(L,Lb) -> - remove_val_from_list(Lb - 1,L). - -higher_Ub(_,'MAX') -> - false; -higher_Ub(L,Ub) -> - remove_val_from_list(Ub + 1,L). - -remove_val_from_list(List,Val) -> - case lists:member(Val,List) of - true -> - {lists:delete(Val,List),Val}; - false -> - false - end. - -%% 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 = 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 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 intersection of all extension roots -%% and only the extension of the last constraint kept if any -%% extension in the last constraint -filter_extensions([]) -> - []; -filter_extensions(C=[_H]) -> - C; -filter_extensions(C) when list(C) -> - filter_extensions(C,[]). - -filter_extensions([C],Acc) -> - lists:reverse([C|Acc]); -filter_extensions([{C,_E},H2|T],Acc) when tuple(C) -> - filter_extensions([H2|T],[C|Acc]); -filter_extensions([{'SizeConstraint',{A,_B}},H2|T],Acc) - when list(A);tuple(A) -> - filter_extensions([H2|T],[{'SizeConstraint',A}|Acc]); -filter_extensions([H1,H2|T],Acc) -> - filter_extensions([H2|T],[H1|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 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,Rest,AisecB++Acc); -constraint_intersection1(S,[A|Rest],Acc) -> - constraint_intersection1(S,Rest,[A|Acc]); -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 = 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(_,[],_VR) -> - []; -intersection_sv_vr(_,_SV,[]) -> - []; -intersection_sv_vr(_S,[C1={'SingleValue',SV}],[C2={'ValueRange',{_Lb,_Ub}}]) - when 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}}) - end; -intersection_sv_vr(_S,[C1={'SingleValue',SV}],[C2]) - when 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}}); - [V] -> [{'SingleValue',V}]; - L -> [{'SingleValue',L}] - end. - - - -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 integer(Int),tuple(Range) -> - case Range of - {Lb,Ub} when 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 integer(Int),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 integer(Int), - list(SV) -> - SV2=intersection_of_sv1(S,Int,SV), - intersection_of_sv(S,[SV2|Rest]); -intersection_of_sv(S,[{_,SV},{_,Int}|Rest]) when integer(Int), - list(SV) -> - SV2=intersection_of_sv1(S,Int,SV), - intersection_of_sv(S,[SV2|Rest]); -intersection_of_sv(S,[{_,SV1},{_,SV2}|Rest]) when list(SV1), - 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 integer(Int),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 integer(Int) -> - true; -is_int_in_vr(Int,{_,{'MIN',Ub}}) when integer(Int),Int =< Ub -> - true; -is_int_in_vr(Int,{_,{Lb,'MAX'}}) when integer(Int),Int >= Lb -> - true; -is_int_in_vr(Int,{_,{Lb,Ub}}) when integer(Int),Int >= Lb,Int =< Ub -> - true; -is_int_in_vr(_,_) -> - false. - - - -check_imported(_S,Imodule,Name) -> - case asn1_db:dbget(Imodule,'MODULE') of - undefined -> - io:format("~s.asn1db not found~n",[Imodule]), - io:format("Type ~s imported from non existing module ~s~n",[Name,Imodule]); - Im when record(Im,module) -> - case is_exported(Im,Name) of - false -> - io:format("Imported type ~s not exported from module ~s~n",[Name,Imodule]); - _ -> - ok - end - end, - ok. - -is_exported(Module,Name) when record(Module,module) -> - {exports,Exports} = Module#module.exports, - case Exports of - all -> - true; - [] -> - false; - L when list(L) -> - case lists:keysearch(Name,#'Externaltypereference'.type,Exports) of - false -> false; - _ -> true - end - end. - - - -check_externaltypereference(S,Etref=#'Externaltypereference'{module=Emod})-> - Currmod = S#state.mname, - MergedMods = S#state.inputmodules, - case Emod of - Currmod -> - %% reference to current module or to imported reference - check_reference(S,Etref); - _ -> - %% io:format("Type ~s IMPORTED FROM ~s~n",[Etype,Emod]), - case lists:member(Emod,MergedMods) of - true -> - check_reference(S,Etref); - false -> - Etref - end - end. - -check_reference(S,#'Externaltypereference'{pos=Pos,module=Emod,type=Name}) -> - ModName = S#state.mname, - case asn1_db:dbget(ModName,Name) of - undefined -> - case imported(S,Name) of - {ok,Imodule} -> - check_imported(S,Imodule,Name), - #'Externaltypereference'{module=Imodule,type=Name}; - _ -> - %may be a renamed type in multi file compiling! - {_,T}=renamed_reference(S,Name,Emod), - NewName = asn1ct:get_name_of_def(T), - NewPos = asn1ct:get_pos_of_def(T), - #'Externaltypereference'{pos=NewPos, - module=ModName, - type=NewName} - end; - _ -> - %% cannot do check_type here due to recursive definitions, like - %% S ::= SEQUENCE {a INTEGER, b S}. This implies that references - %% that appear before the definition will be an - %% Externaltypereference in the abstract syntax tree - #'Externaltypereference'{pos=Pos,module=ModName,type=Name} - end. - - -name2Extref(_Mod,Name) when record(Name,'Externaltypereference') -> - Name; -name2Extref(Mod,Name) -> - #'Externaltypereference'{module=Mod,type=Name}. - -get_referenced_type(S,Ext) when record(Ext,'Externaltypereference') -> - case match_parameters(Ext, S#state.parameters) of - Ext -> - #'Externaltypereference'{pos=Pos,module=Emod,type=Etype} = Ext, - case S#state.mname of - Emod -> % a local reference in this module - get_referenced1(S,Emod,Etype,Pos); - _ ->% always when multi file compiling - case lists:member(Emod,S#state.inputmodules) of - true -> - get_referenced1(S,Emod,Etype,Pos); - false -> - get_referenced(S,Emod,Etype,Pos) - end - end; - Other -> - {undefined,Other} - end; -get_referenced_type(S=#state{mname=Emod}, - ERef=#'Externalvaluereference'{pos=P,module=Emod, - value=Eval}) -> - case match_parameters(ERef,S#state.parameters) of - ERef -> - get_referenced1(S,Emod,Eval,P); - OtherERef when record(OtherERef,'Externalvaluereference') -> - get_referenced_type(S,OtherERef); - Value -> - {Emod,Value} - end; -get_referenced_type(S,ERef=#'Externalvaluereference'{pos=Pos,module=Emod, - value=Eval}) -> - case match_parameters(ERef,S#state.parameters) of - ERef -> - case lists:member(Emod,S#state.inputmodules) of - true -> - get_referenced1(S,Emod,Eval,Pos); - false -> - get_referenced(S,Emod,Eval,Pos) - end; - OtherERef -> - get_referenced_type(S,OtherERef) - end; -get_referenced_type(S,#identifier{val=Name,pos=Pos}) -> - get_referenced1(S,undefined,Name,Pos); -get_referenced_type(_S,Type) -> - {undefined,Type}. - -%% get_referenced/3 -%% The referenced entity Ename may in case of an imported parameterized -%% type reference imported entities in the other module, which implies that -%% asn1_db:dbget will fail even though the referenced entity exists. Thus -%% Emod may be the module that imports the entity Ename and not holds the -%% data about Ename. -get_referenced(S,Emod,Ename,Pos) -> - case asn1_db:dbget(Emod,Ename) of - undefined -> - %% May be an imported entity in module Emod -% throw({error,{asn1,{undefined_type_or_value,{Emod,Ename}}}}); - NewS = S#state{module=asn1_db:dbget(Emod,'MODULE')}, - get_imported(NewS,Ename,Emod,Pos); - T when record(T,typedef) -> - Spec = T#typedef.typespec, - case Spec#type.def of - Tref when record(Tref,typereference) -> - Def = #'Externaltypereference'{module=Emod, - type=Tref#typereference.val, - pos=Tref#typereference.pos}, - - - {Emod,T#typedef{typespec=Spec#type{def=Def}}}; - _ -> - {Emod,T} % should add check that T is exported here - end; - V -> {Emod,V} - end. - -get_referenced1(S,ModuleName,Name,Pos) -> - case asn1_db:dbget(S#state.mname,Name) of - undefined -> - %% ModuleName may be other than S#state.mname when - %% multi file compiling is used. - get_imported(S,Name,ModuleName,Pos); - T -> - {S#state.mname,T} - end. - -get_imported(S,Name,Module,Pos) -> - case imported(S,Name) of - {ok,Imodule} -> - case asn1_db:dbget(Imodule,'MODULE') of - undefined -> - throw({error,{asn1,{module_not_found,Imodule}}}); - Im when record(Im,module) -> - case is_exported(Im,Name) of - false -> - throw({error, - {asn1,{not_exported,{Im,Name}}}}); - _ -> - get_referenced_type(S, - #'Externaltypereference' - {module=Imodule, - type=Name,pos=Pos}) - end - end; - _ -> - renamed_reference(S,Name,Module) - end. - -renamed_reference(S,Name,Module) -> - %% first check if there is a renamed type in this module - %% second check if any type was imported with this name - case ets:info(renamed_defs) of - undefined -> throw({error,{asn1,{undefined_type,Name}}}); - _ -> - case ets:match(renamed_defs,{'$1',Name,Module}) of - [] -> - case ets:info(original_imports) of - undefined -> - throw({error,{asn1,{undefined_type,Name}}}); - _ -> - case ets:match(original_imports,{Module,'$1'}) of - [] -> - throw({error,{asn1,{undefined_type,Name}}}); - [[ImportsList]] -> - case get_importmoduleoftype(ImportsList,Name) of - undefined -> - throw({error,{asn1,{undefined_type,Name}}}); - NextMod -> - renamed_reference(S,Name,NextMod) - end - end - end; - [[NewTypeName]] -> - get_referenced1(S,Module,NewTypeName,undefined) - end - end. - -get_importmoduleoftype([I|Is],Name) -> - Index = #'Externaltypereference'.type, - case lists:keysearch(Name,Index,I#'SymbolsFromModule'.symbols) of - {value,_Ref} -> - (I#'SymbolsFromModule'.module)#'Externaltypereference'.type; - _ -> - get_importmoduleoftype(Is,Name) - end; -get_importmoduleoftype([],_) -> - undefined. - - -match_parameters(Name,[]) -> - Name; - -match_parameters(#'Externaltypereference'{type=Name},[{#'Externaltypereference'{type=Name},NewName}|_T]) -> - NewName; -match_parameters(#'Externaltypereference'{type=Name},[{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) -> - NewName; -% match_parameters(#'Externaltypereference'{type=Name},[{#typereference{val=Name},NewName}|T]) -> -% NewName; -% match_parameters(#'Externaltypereference'{type=Name},[{{_,#typereference{val=Name}},NewName}|T]) -> -% NewName; -%match_parameters(#typereference{val=Name},[{#typereference{val=Name},NewName}|T]) -> -% NewName; -match_parameters(#'Externalvaluereference'{value=Name},[{#'Externalvaluereference'{value=Name},NewName}|_T]) -> - NewName; -match_parameters(#'Externalvaluereference'{value=Name},[{{_,#'Externalvaluereference'{value=Name}},NewName}|_T]) -> - NewName; -% match_parameters(#identifier{val=Name},[{#identifier{val=Name},NewName}|T]) -> -% NewName; -% match_parameters(#identifier{val=Name},[{{_,#identifier{val=Name}},NewName}|T]) -> -% NewName; -match_parameters({valueset,#type{def=#'Externaltypereference'{type=Name}}}, - [{{_,#'Externaltypereference'{type=Name}},{valueset,#type{def=NewName}}}|_T]) -> - NewName; -match_parameters({valueset,#type{def=#'Externaltypereference'{type=Name}}}, - [{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) -> - NewName; -% match_parameters({valueset,#type{def=#'Externaltypereference'{type=Name}}}, -% [{{_,#typereference{val=Name}},{valueset,#type{def=NewName}}}|T]) -> -% NewName; -% match_parameters({valueset,#type{def=#'Externaltypereference'{type=Name}}}, -% [{{_,#typereference{val=Name}},NewName}|T]) -> -% NewName; - -match_parameters(Name, [_H|T]) -> - %%io:format("match_parameters(~p,~p)~n",[Name,[H|T]]), - match_parameters(Name,T). - -imported(S,Name) -> - {imports,Ilist} = (S#state.module)#module.imports, - imported1(Name,Ilist). - -imported1(Name, - [#'SymbolsFromModule'{symbols=Symlist, - module=#'Externaltypereference'{type=ModuleName}}|T]) -> - case lists:keysearch(Name,#'Externaltypereference'.type,Symlist) of - {value,_V} -> - {ok,ModuleName}; - _ -> - imported1(Name,T) - end; -imported1(_Name,[]) -> - false. - - -check_integer(_S,[],_C) -> - ok; -check_integer(S,NamedNumberList,_C) -> - case check_unique(NamedNumberList,2) of - [] -> - check_int(S,NamedNumberList,[]); - L when list(L) -> - error({type,{duplicates,L},S}), - unchanged - - end. - -check_int(S,[{'NamedNumber',Id,Num}|T],Acc) when integer(Num) -> - check_int(S,T,[{Id,Num}|Acc]); -check_int(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc) -> - Val = dbget_ex(S,S#state.mname,Name), - check_int(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc); -check_int(_S,[],Acc) -> - lists:keysort(2,Acc). - - - -check_bitstring(_S,[],_Constr) -> - []; -check_bitstring(S,NamedNumberList,_Constr) -> - case check_unique(NamedNumberList,2) of - [] -> - check_bitstr(S,NamedNumberList,[]); - L when list(L) -> - error({type,{duplicates,L},S}), - unchanged - end. - -check_bitstr(S,[{'NamedNumber',Id,Num}|T],Acc)when integer(Num) -> - check_bitstr(S,T,[{Id,Num}|Acc]); -check_bitstr(S,[{'NamedNumber',Id,Name}|T],Acc) when atom(Name) -> -%%check_bitstr(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc) -> -%% io:format("asn1ct_check:check_bitstr/3 hej hop ~w~n",[Name]), - Val = dbget_ex(S,S#state.mname,Name), -%% io:format("asn1ct_check:check_bitstr/3: ~w~n",[Val]), - check_bitstr(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc); -check_bitstr(S,[],Acc) -> - case check_unique(Acc,2) of - [] -> - lists:keysort(2,Acc); - L when list(L) -> - error({type,{duplicate_values,L},S}), - unchanged - end. - -%%check_bitstring(S,NamedNumberList,Constr) -> -%% NamedNumberList. - -%% Check INSTANCE OF -%% check that DefinedObjectClass is of TYPE-IDENTIFIER class -%% If Constraint is empty make it the general INSTANCE OF type -%% If Constraint is not empty make an inlined type -%% convert INSTANCE OF to the associated type -check_instance_of(S,DefinedObjectClass,Constraint) -> - check_type_identifier(S,DefinedObjectClass), - iof_associated_type(S,Constraint). - - -check_type_identifier(_S,'TYPE-IDENTIFIER') -> - ok; -check_type_identifier(S,Eref=#'Externaltypereference'{}) -> - case get_referenced_type(S,Eref) of - {_,#classdef{name='TYPE-IDENTIFIER'}} -> ok; - {_,TD=#typedef{typespec=#type{def=#'Externaltypereference'{}}}} -> - check_type_identifier(S,(TD#typedef.typespec)#type.def); - _ -> - error({type,{"object set in type INSTANCE OF " - "not of class TYPE-IDENTIFIER",Eref},S}) - end. - -iof_associated_type(S,[]) -> - %% in this case encode/decode functions for INSTANCE OF must be - %% generated - case get(instance_of) of - undefined -> - AssociateSeq = iof_associated_type1(S,[]), - Tag = - case S#state.erule of - ber_bin_v2 -> - [?TAG_CONSTRUCTED(?N_INSTANCE_OF)]; - _ -> [] - end, - TypeDef=#typedef{checked=true, - name='INSTANCE OF', - typespec=#type{tag=Tag, - def=AssociateSeq}}, - asn1_db:dbput(S#state.mname,'INSTANCE OF',TypeDef), - put(instance_of,generate); - _ -> - ok - end, - #'Externaltypereference'{module=S#state.mname,type='INSTANCE OF'}; -iof_associated_type(S,C) -> - iof_associated_type1(S,C). - -iof_associated_type1(S,C) -> - {TableCInf,Comp1Cnstr,Comp2Cnstr,Comp2tablecinf}= - instance_of_constraints(S,C), - - ModuleName = S#state.mname, - Typefield_type= - case C of - [] -> 'ASN1_OPEN_TYPE'; - _ -> {typefield,'Type'} - end, - {ObjIdTag,C1TypeTag}= - case S#state.erule of - ber_bin_v2 -> - {[{'UNIVERSAL',8}], - [#tag{class='UNIVERSAL', - number=6, - type='IMPLICIT', - form=0}]}; - _ -> {[{'UNIVERSAL','INTEGER'}],[]} - end, - TypeIdentifierRef=#'Externaltypereference'{module=ModuleName, - type='TYPE-IDENTIFIER'}, - ObjectIdentifier = - #'ObjectClassFieldType'{classname=TypeIdentifierRef, - class=[], - fieldname={id,[]}, - type={fixedtypevaluefield,id, - #type{def='OBJECT IDENTIFIER'}}}, - Typefield = - #'ObjectClassFieldType'{classname=TypeIdentifierRef, - class=[], - fieldname={'Type',[]}, - type=Typefield_type}, - IOFComponents = - [#'ComponentType'{name='type-id', - typespec=#type{tag=C1TypeTag, - def=ObjectIdentifier, - constraint=Comp1Cnstr}, - prop=mandatory, - tags=ObjIdTag}, - #'ComponentType'{name=value, - typespec=#type{tag=[#tag{class='CONTEXT', - number=0, - type='EXPLICIT', - form=32}], - def=Typefield, - constraint=Comp2Cnstr, - tablecinf=Comp2tablecinf}, - prop=mandatory, - tags=[{'CONTEXT',0}]}], - #'SEQUENCE'{tablecinf=TableCInf, - components=IOFComponents}. - - -%% returns the leading attribute, the constraint of the components and -%% the tablecinf value for the second component. -instance_of_constraints(_,[]) -> - {false,[],[],[]}; -instance_of_constraints(S,#constraint{c={simpletable,Type}}) -> - #type{def=#'Externaltypereference'{type=Name}} = Type, - ModuleName = S#state.mname, - ObjectSetRef=#'Externaltypereference'{module=ModuleName, - type=Name}, - CRel=[{componentrelation,{objectset, - undefined, %% pos - ObjectSetRef}, - [{innermost, - [#'Externalvaluereference'{module=ModuleName, - value=type}]}]}], - TableCInf=#simpletableattributes{objectsetname=Name, - c_name='type-id', - c_index=1, - usedclassfield=id, - uniqueclassfield=id, - 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],_Constr) when atom(Name), integer(Number)-> - %% already checked , just return the same list - [{Name,Number}|Rest]; -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) when integer(Num) -> - check_enum(S,T,[{Id,Num}|Acc1],Acc2); -check_enum(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc1,Acc2) -> - Val = dbget_ex(S,S#state.mname,Name), - check_enum(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc1,Acc2); -check_enum(S,['EXTENSIONMARK'|T],Acc1,Acc2) -> - NewAcc2 = lists:keysort(2,Acc1), - NewList = enum_number(lists:reverse(Acc2),NewAcc2,0,[]), - { NewList, check_enum(S,T,[],[])}; -check_enum(S,[Id|T],Acc1,Acc2) when atom(Id) -> - check_enum(S,T,Acc1,[Id|Acc2]); -check_enum(_S,[],Acc1,Acc2) -> - NewAcc2 = lists:keysort(2,Acc1), - enum_number(lists:reverse(Acc2),NewAcc2,0,[]). - - -% assign numbers to identifiers , numbers from 0 ... but must not -% be the same as already assigned to NamedNumbers -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:concat([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]). - - -check_boolean(_S,_Constr) -> - ok. - -check_octetstring(_S,_Constr) -> - ok. - -% check all aspects of a SEQUENCE -% - that all component names are unique -% - that all TAGS are ok (when TAG default is applied) -% - that each component is of a valid type -% - that the extension marks are valid - -check_sequence(S,Type,Comps) -> - Components = expand_components(S,Comps), - case check_unique([C||C <- Components ,record(C,'ComponentType')] - ,#'ComponentType'.name) of - [] -> - %% sort_canonical(Components), - Components2 = maybe_automatic_tags(S,Components), - %% check the table constraints from here. The outermost type - %% is Type, the innermost is Comps (the list of components) - NewComps = - case check_each_component(S,Type,Components2) of - NewComponents when list(NewComponents) -> - check_unique_sequence_tags(S,NewComponents), - NewComponents; - Ret = {NewComponents,NewEcomps} -> - TagComps = NewComponents ++ - [Comp#'ComponentType'{prop='OPTIONAL'}|| Comp <- NewEcomps], - %% extension components are like optionals when it comes to tagging - check_unique_sequence_tags(S,TagComps), - Ret - end, - %% CRelInf is the "leading attribute" information - %% necessary for code generating of the look up in the - %% object set table, - %% i.e. getenc_ObjectSet/getdec_ObjectSet. - %% {objfun,ERef} tuple added in NewComps2 in tablecinf - %% field in type record of component relation constrained - %% type -% io:format("NewComps: ~p~n",[NewComps]), - {CRelInf,NewComps2} = componentrelation_leadingattr(S,NewComps), -% io:format("CRelInf: ~p~n",[CRelInf]), -% io:format("NewComps2: ~p~n",[NewComps2]), - %% CompListWithTblInf has got a lot unecessary info about - %% the involved class removed, as the class of the object - %% set. - CompListWithTblInf = get_tableconstraint_info(S,Type,NewComps2), -% io:format("CompListWithTblInf: ~p~n",[CompListWithTblInf]), - {CRelInf,CompListWithTblInf}; - Dupl -> - throw({error,{asn1,{duplicate_components,Dupl}}}) - end. - -expand_components(S, [{'COMPONENTS OF',Type}|T]) -> - CompList = - case get_referenced_type(S,Type#type.def) of - {_,#typedef{typespec=#type{def=Seq}}} when record(Seq,'SEQUENCE') -> - case Seq#'SEQUENCE'.components of - {Root,_Ext} -> Root; - Root -> Root - end; - Err -> throw({error,{asn1,{illegal_COMPONENTS_OF,Err}}}) - end, - expand_components(S,CompList) ++ expand_components(S,T); -expand_components(S,[H|T]) -> - [H|expand_components(S,T)]; -expand_components(_,[]) -> - []. - -check_unique_sequence_tags(S,[#'ComponentType'{prop=mandatory}|Rest]) -> - check_unique_sequence_tags(S,Rest); -check_unique_sequence_tags(S,[C|Rest]) when record(C,'ComponentType') -> - check_unique_sequence_tags1(S,Rest,[C]);% optional or default -check_unique_sequence_tags(S,[_ExtensionMarker|Rest]) -> - check_unique_sequence_tags(S,Rest); -check_unique_sequence_tags(_S,[]) -> - true. - -check_unique_sequence_tags1(S,[C|Rest],Acc) when record(C,'ComponentType') -> - case C#'ComponentType'.prop of - mandatory -> - check_unique_tags(S,lists:reverse([C|Acc])), - check_unique_sequence_tags(S,Rest); - _ -> - check_unique_sequence_tags1(S,Rest,[C|Acc]) % default or optional - end; -check_unique_sequence_tags1(S,[H|Rest],Acc) -> - check_unique_sequence_tags1(S,Rest,[H|Acc]); -check_unique_sequence_tags1(S,[],Acc) -> - check_unique_tags(S,lists:reverse(Acc)). - -check_sequenceof(S,Type,Component) when record(Component,type) -> - check_type(S,Type,Component). - -check_set(S,Type,Components) -> - {TableCInf,NewComponents} = check_sequence(S,Type,Components), - case lists:member(der,S#state.options) of - true when S#state.erule == ber; - S#state.erule == ber_bin -> - {Sorted,SortedComponents} = - sort_components(S#state.tname, - (S#state.module)#module.tagdefault, - NewComponents), - {Sorted,TableCInf,SortedComponents}; - _ -> - {false,TableCInf,NewComponents} - end. - -sort_components(_TypeName,'AUTOMATIC',Components) -> - {true,Components}; -sort_components(TypeName,_TagDefault,Components) -> - case untagged_choice(Components) of - false -> - {true,sort_components1(TypeName,Components,[],[],[],[])}; - true -> - {dynamic,Components} % sort in run-time - end. - -sort_components1(TypeName,[C=#'ComponentType'{tags=[{'UNIVERSAL',_}|_R]}|Cs], - UnivAcc,ApplAcc,ContAcc,PrivAcc) -> - sort_components1(TypeName,Cs,[C|UnivAcc],ApplAcc,ContAcc,PrivAcc); -sort_components1(TypeName,[C=#'ComponentType'{tags=[{'APPLICATION',_}|_R]}|Cs], - UnivAcc,ApplAcc,ContAcc,PrivAcc) -> - sort_components1(TypeName,Cs,UnivAcc,[C|ApplAcc],ContAcc,PrivAcc); -sort_components1(TypeName,[C=#'ComponentType'{tags=[{'CONTEXT',_}|_R]}|Cs], - UnivAcc,ApplAcc,ContAcc,PrivAcc) -> - sort_components1(TypeName,Cs,UnivAcc,ApplAcc,[C|ContAcc],PrivAcc); -sort_components1(TypeName,[C=#'ComponentType'{tags=[{'PRIVATE',_}|_R]}|Cs], - UnivAcc,ApplAcc,ContAcc,PrivAcc) -> - sort_components1(TypeName,Cs,UnivAcc,ApplAcc,ContAcc,[C|PrivAcc]); -sort_components1(TypeName,[],UnivAcc,ApplAcc,ContAcc,PrivAcc) -> - I = #'ComponentType'.tags, - ascending_order_check(TypeName,sort_universal_type(UnivAcc)) ++ - ascending_order_check(TypeName,lists:keysort(I,ApplAcc)) ++ - ascending_order_check(TypeName,lists:keysort(I,ContAcc)) ++ - ascending_order_check(TypeName,lists:keysort(I,PrivAcc)). - -ascending_order_check(TypeName,Components) -> - ascending_order_check1(TypeName,Components), - Components. - -ascending_order_check1(TypeName, - [C1 = #'ComponentType'{tags=[{_,T}|_]}, - C2 = #'ComponentType'{tags=[{_,T}|_]}|Rest]) -> - io:format("WARNING: Indistinct tag ~p in SET ~p, components ~p and ~p~n", - [T,TypeName,C1#'ComponentType'.name,C2#'ComponentType'.name]), - ascending_order_check1(TypeName,[C2|Rest]); -ascending_order_check1(TypeName, - [C1 = #'ComponentType'{tags=[{'UNIVERSAL',T1}|_]}, - C2 = #'ComponentType'{tags=[{'UNIVERSAL',T2}|_]}|Rest]) -> - case (asn1ct_gen_ber:decode_type(T1) == asn1ct_gen_ber:decode_type(T2)) of - true -> - io:format("WARNING: Indistinct tags ~p and ~p in" - " SET ~p, components ~p and ~p~n", - [T1,T2,TypeName,C1#'ComponentType'.name, - C2#'ComponentType'.name]), - ascending_order_check1(TypeName,[C2|Rest]); - _ -> - ascending_order_check1(TypeName,[C2|Rest]) - end; -ascending_order_check1(N,[_|Rest]) -> - ascending_order_check1(N,Rest); -ascending_order_check1(_,[_]) -> - ok; -ascending_order_check1(_,[]) -> - ok. - -sort_universal_type(Components) -> - List = lists:map(fun(C) -> - #'ComponentType'{tags=[{_,T}|_]} = C, - {asn1ct_gen_ber:decode_type(T),C} - end, - Components), - SortedList = lists:keysort(1,List), - lists:map(fun(X)->element(2,X) end,SortedList). - -untagged_choice([#'ComponentType'{typespec=#type{tag=[],def={'CHOICE',_}}}|_Rest]) -> - true; -untagged_choice([_|Rest]) -> - untagged_choice(Rest); -untagged_choice([]) -> - false. - -check_setof(S,Type,Component) when record(Component,type) -> - check_type(S,Type,Component). - -check_restrictedstring(_S,_Def,_Constr) -> - ok. - -check_objectidentifier(_S,_Constr) -> - ok. - -% check all aspects of a CHOICE -% - that all alternative names are unique -% - that all TAGS are ok (when TAG default is applied) -% - that each alternative is of a valid type -% - that the extension marks are valid -check_choice(S,Type,Components) when list(Components) -> - case check_unique([C||C <- Components, - record(C,'ComponentType')],#'ComponentType'.name) of - [] -> - %% sort_canonical(Components), - Components2 = maybe_automatic_tags(S,Components), - %NewComps = - case check_each_alternative(S,Type,Components2) of - {NewComponents,NewEcomps} -> - check_unique_tags(S,NewComponents ++ NewEcomps), - {NewComponents,NewEcomps}; - NewComponents -> - check_unique_tags(S,NewComponents), - NewComponents - end; -%% CompListWithTblInf = get_tableconstraint_info(S,Type,NewComps); - Dupl -> - throw({error,{asn1,{duplicate_choice_alternatives,Dupl}}}) - end; -check_choice(_S,_,[]) -> - []. - -%% probably dead code that should be removed -%%maybe_automatic_tags(S,{Rc,Ec}) -> -%% {maybe_automatic_tags1(S,Rc,0),maybe_automatic_tags1(S,Ec,length(Rc))}; -maybe_automatic_tags(#state{erule=per},C) -> - C; -maybe_automatic_tags(#state{erule=per_bin},C) -> - C; -maybe_automatic_tags(S,C) -> - maybe_automatic_tags1(S,C,0). - -maybe_automatic_tags1(S,C,TagNo) -> - case (S#state.module)#module.tagdefault of - 'AUTOMATIC' -> - generate_automatic_tags(S,C,TagNo); - _ -> - %% maybe is the module a multi file module were only some of - %% the modules have defaulttag AUTOMATIC TAGS then the names - %% of those types are saved in the table automatic_tags - Name= S#state.tname, - case is_automatic_tagged_in_multi_file(Name) of - true -> - generate_automatic_tags(S,C,TagNo); - false -> - C - end - end. - -is_automatic_tagged_in_multi_file(Name) -> - case ets:info(automatic_tags) of - undefined -> - %% this case when not multifile compilation - false; - _ -> - case ets:member(automatic_tags,Name) of - true -> - true; - _ -> - false - end - end. - -generate_automatic_tags(_S,C,TagNo) -> - case any_manual_tag(C) of - true -> - C; - false -> - generate_automatic_tags1(C,TagNo) - end. - -generate_automatic_tags1([H|T],TagNo) when record(H,'ComponentType') -> - #'ComponentType'{typespec=Ts} = H, - NewTs = Ts#type{tag=[#tag{class='CONTEXT', - number=TagNo, - type={default,'IMPLICIT'}, - form= 0 }]}, % PRIMITIVE - [H#'ComponentType'{typespec=NewTs}|generate_automatic_tags1(T,TagNo+1)]; -generate_automatic_tags1([ExtMark|T],TagNo) -> % EXTENSIONMARK - [ExtMark | generate_automatic_tags1(T,TagNo)]; -generate_automatic_tags1([],_) -> - []. - -any_manual_tag([#'ComponentType'{typespec=#type{tag=[]}}|Rest]) -> - any_manual_tag(Rest); -any_manual_tag([{'EXTENSIONMARK',_,_}|Rest]) -> - any_manual_tag(Rest); -any_manual_tag([_|_Rest]) -> - true; -any_manual_tag([]) -> - false. - - -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,[]) - end; - _ -> - collect_and_sort_tags(C,[]) - end. - -collect_and_sort_tags([C|Rest],Acc) when 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 - end. - -check_unique(L,Pos) -> - Slist = lists:keysort(Pos,L), - check_unique2(Slist,Pos,[]). - -check_unique2([A,B|T],Pos,Acc) when element(Pos,A) == element(Pos,B) -> - check_unique2([B|T],Pos,[element(Pos,B)|Acc]); -check_unique2([_|T],Pos,Acc) -> - check_unique2(T,Pos,Acc); -check_unique2([],_,Acc) -> - lists:reverse(Acc). - -check_each_component(S,Type,{Rlist,ExtList}) -> - {check_each_component(S,Type,Rlist), - check_each_component(S,Type,ExtList)}; -check_each_component(S,Type,Components) -> - check_each_component(S,Type,Components,[],[],noext). - -check_each_component(S = #state{abscomppath=Path,recordtopname=TopName},Type, - [C|Ct],Acc,Extacc,Ext) when record(C,'ComponentType') -> - #'ComponentType'{name=Cname,typespec=Ts,prop=Prop} = C, - NewAbsCPath = - case Ts#type.def of - #'Externaltypereference'{} -> []; - _ -> [Cname|Path] - end, - CheckedTs = check_type(S#state{abscomppath=NewAbsCPath, - recordtopname=[Cname|TopName]},Type,Ts), - NewTags = get_taglist(S,CheckedTs), - - NewProp = -% case lists:member(der,S#state.options) of -% true -> -% True -> - case normalize_value(S,CheckedTs,Prop,[Cname|TopName]) of - mandatory -> mandatory; - 'OPTIONAL' -> 'OPTIONAL'; - DefaultValue -> {'DEFAULT',DefaultValue} - end, -% _ -> -% Prop -% end, - NewC = C#'ComponentType'{typespec=CheckedTs,prop=NewProp,tags=NewTags}, - case Ext of - noext -> - check_each_component(S,Type,Ct,[NewC|Acc],Extacc,Ext); - ext -> - check_each_component(S,Type,Ct,Acc,[NewC|Extacc],Ext) - end; -check_each_component(S,Type,[_|Ct],Acc,Extacc,noext) -> % skip 'EXTENSIONMARK' - check_each_component(S,Type,Ct,Acc,Extacc,ext); -check_each_component(_S,_,[_C|_Ct],_,_,ext) -> % skip 'EXTENSIONMARK' - throw({error,{asn1,{too_many_extension_marks}}}); -check_each_component(_S,_,[],Acc,Extacc,ext) -> - {lists:reverse(Acc),lists:reverse(Extacc)}; -check_each_component(_S,_,[],Acc,_,noext) -> - lists:reverse(Acc). - -check_each_alternative(S,Type,{Rlist,ExtList}) -> - {check_each_alternative(S,Type,Rlist), - check_each_alternative(S,Type,ExtList)}; -check_each_alternative(S,Type,[C|Ct]) -> - check_each_alternative(S,Type,[C|Ct],[],[],noext). - -check_each_alternative(S=#state{abscomppath=Path,recordtopname=TopName},Type,[C|Ct], - Acc,Extacc,Ext) when record(C,'ComponentType') -> - #'ComponentType'{name=Cname,typespec=Ts,prop=_Prop} = C, - NewAbsCPath = - case Ts#type.def of - #'Externaltypereference'{} -> []; - _ -> [Cname|Path] - end, - NewState = - S#state{abscomppath=NewAbsCPath,recordtopname=[Cname|TopName]}, - CheckedTs = check_type(NewState,Type,Ts), - NewTags = get_taglist(S,CheckedTs), - NewC = C#'ComponentType'{typespec=CheckedTs,tags=NewTags}, - case Ext of - noext -> - check_each_alternative(S,Type,Ct,[NewC|Acc],Extacc,Ext); - ext -> - check_each_alternative(S,Type,Ct,Acc,[NewC|Extacc],Ext) - end; - -check_each_alternative(S,Type,[_|Ct],Acc,Extacc,noext) -> % skip 'EXTENSIONMARK' - check_each_alternative(S,Type,Ct,Acc,Extacc,ext); -check_each_alternative(_S,_,[_C|_Ct],_,_,ext) -> % skip 'EXTENSIONMARK' - throw({error,{asn1,{too_many_extension_marks}}}); -check_each_alternative(_S,_,[],Acc,Extacc,ext) -> - {lists:reverse(Acc),lists:reverse(Extacc)}; -check_each_alternative(_S,_,[],Acc,_,noext) -> - lists:reverse(Acc). - -%% componentrelation_leadingattr/2 searches the structure for table -%% constraints, if any is found componentrelation_leadingattr/5 is -%% called. -componentrelation_leadingattr(S,CompList) -> -% {Cs1,Cs2} = - Cs = - case CompList of - {Components,EComponents} when list(Components) -> -% {Components,Components}; - Components ++ EComponents; - CompList when list(CompList) -> -% {CompList,CompList} - CompList - end, -% case any_simple_table(S,Cs1,[]) of - - %% get_simple_table_if_used/2 should find out whether there are any - %% component relation constraints in the entire tree of Cs1 that - %% relates to this level. It returns information about the simple - %% table constraint necessary for the the call to - %% componentrelation_leadingattr/6. The step when the leading - %% attribute and the syntax tree is modified to support the code - %% generating. - case get_simple_table_if_used(S,Cs) of - [] -> {false,CompList}; - STList -> -% componentrelation_leadingattr(S,Cs1,Cs2,STList,[],[]) - componentrelation_leadingattr(S,Cs,Cs,STList,[],[]) - end. - -%% componentrelation_leadingattr/6 when all components are searched -%% the new modified components are returned together with the "leading -%% attribute" information, which later is stored in the tablecinf -%% field in the SEQUENCE/SET record. The "leading attribute" -%% information is used to generate the lookup in the object set -%% table. The other information gathered in the #type.tablecinf field -%% is used in code generating phase too, to recognice the proper -%% components for "open type" encoding and to propagate the result of -%% the object set lookup when needed. -componentrelation_leadingattr(_,[],_CompList,_,[],NewCompList) -> - {false,lists:reverse(NewCompList)}; -componentrelation_leadingattr(_,[],_CompList,_,LeadingAttr,NewCompList) -> - {lists:last(LeadingAttr),lists:reverse(NewCompList)}; %send all info in Ts later -componentrelation_leadingattr(S,[C|Cs],CompList,STList,Acc,CompAcc) -> - {LAAcc,NewC} = - case catch componentrelation1(S,C#'ComponentType'.typespec, - [C#'ComponentType'.name]) of - {'EXIT',_} -> - {[],C}; - {CRI=[{_A1,_B1,_C1,_D1}|_Rest],NewTSpec} -> - %% {ObjectSet,AtPath,ClassDef,Path} - %% _A1 is a reference to the object set of the - %% component relation constraint. - %% _B1 is the path of names in the at-list of the - %% component relation constraint. - %% _C1 is the class definition of the - %% ObjectClassFieldType. - %% _D1 is the path of components that was traversed to - %% find this constraint. - case leading_attr_index(S,CompList,CRI, - lists:reverse(S#state.abscomppath),[]) of - [] -> - {[],C}; - [{ObjSet,Attr,N,ClassDef,_Path,ValueIndex}|_NewRest] -> - OS = object_set_mod_name(S,ObjSet), - UniqueFieldName = - case (catch get_unique_fieldname(#classdef{typespec=ClassDef})) of - {error,'__undefined_'} -> - no_unique; - {asn1,Msg,_} -> - error({type,Msg,S}); - Other -> Other - end, -% UsedFieldName = get_used_fieldname(S,Attr,STList), - %% 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, - valueindex=ValueIndex}, - {[Res],C#'ComponentType'{typespec=NewTSpec}} - end; - _ -> - %% no constraint was found - {[],C} - end, - componentrelation_leadingattr(S,Cs,CompList,STList,LAAcc++Acc, - [NewC|CompAcc]). - -object_set_mod_name(_S,ObjSet) when atom(ObjSet) -> - ObjSet; -object_set_mod_name(#state{mname=M}, - #'Externaltypereference'{module=M,type=T}) -> - T; -object_set_mod_name(S,#'Externaltypereference'{module=M,type=T}) -> - case lists:member(M,S#state.inputmodules) of - true -> - T; - false -> - {M,T} - end. - -%% get_used_fieldname gets the used field of the class referenced by -%% the ObjectClassFieldType construct in the simple table constraint -%% corresponding to the component relation constraint that depends on -%% it. -% get_used_fieldname(_S,CName,[{[CName|_Rest],_,ClFieldName}|_RestSimpleT]) -> -% ClFieldName; -% get_used_fieldname(S,CName,[_SimpleTC|Rest]) -> -% get_used_fieldname(S,CName,Rest); -% get_used_fieldname(S,_,[]) -> -% error({type,"Error in Simple table constraint",S}). - -%% any_simple_table/3 checks if any of the components on this level is -%% constrained by a simple table constraint. It returns a list of -%% tuples with three elements. It is a name path to the place in the -%% type structure where the constraint is, and the name of the object -%% set and the referenced field in the class. -% any_simple_table(S = #state{mname=M,abscomppath=Path}, -% [#'ComponentType'{name=Name,typespec=Type}|Cs],Acc) -> -% Constraint = Type#type.constraint, -% case lists:keysearch(simpletable,1,Constraint) of -% {value,{_,#type{def=Ref}}} -> -% %% This ObjectClassFieldType, which has a simple table -% %% constraint, must pick a fixed type value, mustn't it ? -% {ClassDef,[{_,ClassFieldName}]} = Type#type.def, -% ST = -% case Ref of -% #'Externaltypereference'{module=M,type=ObjSetName} -> -% {[Name|Path],ObjSetName,ClassFieldName}; -% _ -> -% {[Name|Path],Ref,ClassFieldName} -% end, -% any_simple_table(S,Cs,[ST|Acc]); -% false -> -% any_simple_table(S,Cs,Acc) -% end; -% any_simple_table(_,[],Acc) -> -% lists:reverse(Acc); -% any_simple_table(S,[_|Cs],Acc) -> -% any_simple_table(S,Cs,Acc). - -%% get_simple_table_if_used/2 searches the structure of Cs for any -%% component relation constraints due to the present level of the -%% structure. If there are any, the necessary information for code -%% generation of the look up functionality in the object set table are -%% returned. -get_simple_table_if_used(S,Cs) -> - CNames = lists:map(fun(#'ComponentType'{name=Name}) -> Name; - (_) -> [] %% in case of extension marks - end, - Cs), - RefedSimpleTable=any_component_relation(S,Cs,CNames,[],[]), - get_simple_table_info(S,Cs,remove_doubles(RefedSimpleTable)). - -remove_doubles(L) -> - remove_doubles(L,[]). -remove_doubles([H|T],Acc) -> - NewT = remove_doubles1(H,T), - remove_doubles(NewT,[H|Acc]); -remove_doubles([],Acc) -> - Acc. - -remove_doubles1(El,L) -> - case lists:delete(El,L) of - L -> L; - NewL -> remove_doubles1(El,NewL) - end. - -%% get_simple_table_info searches the commponents 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. -%% -%% Returns a list of tuples with three elements. It holds a list of -%% atoms that is the path, the name of the field of the class that are -%% referred to in the ObjectClassFieldType, and the name of the unique -%% field of the class of the ObjectClassFieldType. -%% -% %% The level information outermost/innermost must be kept. There are -% %% at least two possibilities to cover here for an outermost case: 1) -% %% Both the simple table and the component relation have a common path -% %% 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,S#state.abscomppath)|get_simple_table_info(S,Cs,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 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 Cnstr of - [{simpletable,_OSRef}]�-> - #'ObjectClassFieldType'{classname=ClRef, - class=ObjectClass, - fieldname=FieldName} = OCFT, -% #'ObjectClassFieldType'{ObjectClass,FieldType} = ObjectClassFieldType, - ObjectClassFieldName = - case FieldName of - {LastFieldName,[]} -> LastFieldName; - {_FirstFieldName,FieldNames} -> - lists:last(FieldNames) - end, - %%ObjectClassFieldName is the last element in the dotted - %%list of the ObjectClassFieldType. The last element may - %%be of another class, that is referenced from the class - %%of the ObjectClassFieldType - ClassDef = - case ObjectClass of - [] -> - {_,CDef}=get_referenced_type(S,ClRef), - CDef; - _ -> #classdef{typespec=ObjectClass} - end, - UniqueName = - case (catch get_unique_fieldname(ClassDef)) of - {error,'__undefined_'} -> no_unique; - {asn1,Msg,_} -> - error({type,Msg,S}); - Other -> Other - end, - {lists:reverse(Path),ObjectClassFieldName,UniqueName}; - _ -> - error({type,{asn1,"missing expected simple table constraint", - Cnstr},S}) - end; -get_simple_table_info1(S,#'ComponentType'{typespec=TS},Cnames,Path) -> - Components = get_atlist_components(TS#type.def), - get_simple_table_info1(S,Components,Cnames,Path). - -%% any_component_relation searches for all component relation -%% constraints that refers to the actual level and returns a list of -%% the "name path" in the at-list to the component relation constraint -%% that must refer to a simple table constraint. The list is empty if -%% no component relation constraints were found. -%% -%% NamePath has the names of all components that are followed from the -%% beginning of the search. CNames holds the names of all components -%% of the start level, this info is used if an outermost at-notation -%% is found to check the validity of the at-list. -any_component_relation(S,[C|Cs],CNames,NamePath,Acc) -> - CName = C#'ComponentType'.name, - Type = C#'ComponentType'.typespec, - CRelPath = - case Type#type.constraint of - [{componentrelation,_,AtNotation}] -> - %% Found component relation constraint, now check - %% whether this constraint is relevant for the level - %% where the search started - AtNot = extract_at_notation(AtNotation), - %% evaluate_atpath returns the relative path to the - %% simple table constraint from where the component - %% relation is found. - evaluate_atpath(S#state.abscomppath,NamePath,CNames,AtNot); - _ -> - [] - end, - InnerAcc = - case {Type#type.inlined, - asn1ct_gen:type(asn1ct_gen:get_inner(Type#type.def))} of - {no,{constructed,bif}} -> - InnerCs = - case get_components(Type#type.def) of - {IC1,_IC2} -> IC1 ++ IC1; - IC -> IC - end, - %% here we are interested in components of an - %% SEQUENCE/SET OF as well as SEQUENCE, SET and CHOICE - any_component_relation(S,InnerCs,CNames,[CName|NamePath],[]); - _ -> - [] - end, - any_component_relation(S,Cs,CNames,NamePath,InnerAcc++CRelPath++Acc); -any_component_relation(_,[],_,_,Acc) -> - Acc. - -%% 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 -%% found AtPath is refering to the same sub-branch as the simple table -%% has, then there shall not be any leading attribute info on this -%% level. -evaluate_atpath(_,[],Cnames,{innermost,AtPath=[Ref|_Refs]}) -> - %% any innermost constraint found deeper in the structure is - %% ignored. - case lists:member(Ref,Cnames) of - true -> [AtPath]; - false -> [] - end; -%% In this case must check that the AtPath doesn't step any step of -%% the NamePath, in that case the constraint will be handled in an -%% inner level. -evaluate_atpath(TopPath,NamePath,Cnames,{outermost,AtPath=[_Ref|_Refs]}) -> - AtPathBelowTop = - case TopPath of - [] -> AtPath; - _ -> - case lists:prefix(TopPath,AtPath) of - true -> - lists:subtract(AtPath,TopPath); - _ -> [] - end - end, - case {NamePath,AtPathBelowTop} of - {[H|_T1],[H|_T2]} -> []; % this must be handled in lower level - {_,[]} -> [];% this must be handled in an above level - {_,[H|_T]} -> - case lists:member(H,Cnames) of - true -> [AtPathBelowTop]; - _ -> error({type,{asn1,"failed to analyze at-path",AtPath}}) - end - end; -evaluate_atpath(_,_,_,_) -> - []. - -%% Type may be any of SEQUENCE, SET, CHOICE, SEQUENCE OF, SET OF but -%% only the three first have valid components. -get_atlist_components(Def) -> - get_components(atlist,Def). - -get_components(Def) -> - get_components(any,Def). - -get_components(_,#'SEQUENCE'{components=Cs}) -> - Cs; -get_components(_,#'SET'{components=Cs}) -> - Cs; -get_components(_,{'CHOICE',Cs}) -> - Cs; -get_components(any,{'SEQUENCE OF',#type{def=Def}}) -> - get_components(any,Def); -get_components(any,{'SET OF',#type{def=Def}}) -> - get_components(any,Def); -get_components(_,_) -> - []. - - -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([]) -> - []. - -%% componentrelation1/1 identifies all componentrelation constraints -%% that exist in C or in the substructure of C. Info about the found -%% constraints are returned in a list. It is ObjectSet, the reference -%% to the object set, AttrPath, the name atoms extracted from the -%% at-list in the component relation constraint, ClassDef, the -%% objectclass record of the class of the ObjectClassFieldType, Path, -%% that is the component name "path" from the searched level to this -%% constraint. -%% -%% The function is called with one component of the type in turn and -%% with the component name in Path at the first call. When called from -%% within, the name of the inner component is added to Path. -componentrelation1(S,C = #type{def=Def,constraint=Constraint,tablecinf=TCI}, - Path) -> - Ret = - case Constraint of - [{componentrelation,{_,_,ObjectSet},AtList}|_Rest] -> - [{_,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 - %% relevant at-list is of "outermost" type. -%% #'ObjectClassFieldType'{class=ClassDef} = Def, - ClassDef = get_ObjectClassFieldType_classdef(S,Def), - AtPath = - lists:map(fun(#'Externalvaluereference'{value=V})->V end, - AL), - {[{ObjectSet,AtPath,ClassDef,Path}],Def}; - _Other -> - %% check the inner type of component - innertype_comprel(S,Def,Path) - end, - case Ret of - nofunobj -> - nofunobj; %% ignored by caller - {CRelI=[{ObjSet,_,_,_}],NewDef} -> %% - TCItmp = lists:subtract(TCI,[{objfun,ObjSet}]), - {CRelI,C#type{tablecinf=[{objfun,ObjSet}|TCItmp],def=NewDef}}; - {CompRelInf,NewDef} -> %% more than one tuple in CompRelInf - TCItmp = lists:subtract(TCI,[{objfun,anyset}]), - {CompRelInf,C#type{tablecinf=[{objfun,anyset}|TCItmp],def=NewDef}} - end. - -innertype_comprel(S,{'SEQUENCE OF',Type},Path) -> - case innertype_comprel1(S,Type,Path) of - nofunobj -> - nofunobj; - {CompRelInf,NewType} -> - {CompRelInf,{'SEQUENCE OF',NewType}} - end; -innertype_comprel(S,{'SET OF',Type},Path) -> - case innertype_comprel1(S,Type,Path) of - nofunobj -> - nofunobj; - {CompRelInf,NewType} -> - {CompRelInf,{'SET OF',NewType}} - end; -innertype_comprel(S,{'CHOICE',CTypeList},Path) -> - case componentlist_comprel(S,CTypeList,[],Path,[]) of - nofunobj -> - nofunobj; - {CompRelInf,NewCs} -> - {CompRelInf,{'CHOICE',NewCs}} - end; -innertype_comprel(S,Seq = #'SEQUENCE'{components=Cs},Path) -> - case componentlist_comprel(S,Cs,[],Path,[]) of - nofunobj -> - nofunobj; - {CompRelInf,NewCs} -> - {CompRelInf,Seq#'SEQUENCE'{components=NewCs}} - end; -innertype_comprel(S,Set = #'SET'{components=Cs},Path) -> - case componentlist_comprel(S,Cs,[],Path,[]) of - nofunobj -> - nofunobj; - {CompRelInf,NewCs} -> - {CompRelInf,Set#'SET'{components=NewCs}} - end; -innertype_comprel(_,_,_) -> - nofunobj. - -componentlist_comprel(S,[C = #'ComponentType'{name=Name,typespec=Type}|Cs], - Acc,Path,NewCL) -> - case catch componentrelation1(S,Type,Path++[Name]) of - {'EXIT',_} -> - componentlist_comprel(S,Cs,Acc,Path,[C|NewCL]); - nofunobj -> - componentlist_comprel(S,Cs,Acc,Path,[C|NewCL]); - {CRelInf,NewType} -> - componentlist_comprel(S,Cs,CRelInf++Acc,Path, - [C#'ComponentType'{typespec=NewType}|NewCL]) - end; -componentlist_comprel(_,[],Acc,_,NewCL) -> - case Acc of - [] -> - nofunobj; - _ -> - {Acc,lists:reverse(NewCL)} - end. - -innertype_comprel1(S,T = #type{def=Def,constraint=Cons,tablecinf=TCI},Path) -> - Ret = - case Cons of - [{componentrelation,{_,_,ObjectSet},AtList}|_Rest] -> - %% This AtList must have an "outermost" at sign to be - %% relevent here. - [{_,AL=[#'Externalvaluereference'{value=_Attr}|_R1]}|_R2] - = AtList, -%% #'ObjectClassFieldType'{class=ClassDef} = Def, - ClassDef = get_ObjectClassFieldType_classdef(S,Def), - AtPath = - lists:map(fun(#'Externalvaluereference'{value=V})->V end, - AL), - [{ObjectSet,AtPath,ClassDef,Path}]; - _ -> - innertype_comprel(S,Def,Path) - end, - case Ret of - nofunobj -> nofunobj; - L = [{ObjSet,_,_,_}] -> - TCItmp = lists:subtract(TCI,[{objfun,ObjSet}]), - {L,T#type{tablecinf=[{objfun,ObjSet}|TCItmp]}}; - {CRelInf,NewDef} -> - TCItmp = lists:subtract(TCI,[{objfun,anyset}]), - {CRelInf,T#type{def=NewDef,tablecinf=[{objfun,anyset}|TCItmp]}} - end. - - -%% leading_attr_index counts the index and picks the name of the -%% component that is at the actual level in the at-list of the -%% component relation constraint (AttrP). AbsP is the path of -%% component names from the top type level to the actual level. AttrP -%% is a list with the atoms from the at-list. -leading_attr_index(S,Cs,[H={_,AttrP,_,_}|T],AbsP,Acc) -> - AttrInfo = - case lists:prefix(AbsP,AttrP) of - %% why this ?? It is necessary when in same situation as - %% TConstrChoice, there is an inner structure with an - %% outermost at-list and the "leading attribute" code gen - %% may be at a level some steps below the outermost level. - true -> - RelativAttrP = lists:subtract(AttrP,AbsP), - %% The header is used to calculate the index of the - %% component and to give the fun, received from the - %% object set look up, an unique name. The tail is - %% used to match the proper value input to the fun. - {hd(RelativAttrP),tl(RelativAttrP)}; - false -> - {hd(AttrP),tl(AttrP)} - end, - case leading_attr_index1(S,Cs,H,AttrInfo,1) of - 0 -> - leading_attr_index(S,Cs,T,AbsP,Acc); - Res -> - leading_attr_index(S,Cs,T,AbsP,[Res|Acc]) - end; -leading_attr_index(_,_Cs,[],_,Acc) -> - lists:reverse(Acc). - -leading_attr_index1(_,[],_,_,_) -> - 0; -leading_attr_index1(S,[C|Cs],Arg={ObjectSet,_,CDef,P}, - AttrInfo={Attr,SubAttr},N) -> - case C#'ComponentType'.name of - Attr -> - ValueMatch = value_match(S,C,Attr,SubAttr), - {ObjectSet,Attr,N,CDef,P,ValueMatch}; - _ -> - leading_attr_index1(S,Cs,Arg,AttrInfo,N+1) - end. - -%% value_math gathers information for a proper value match in the -%% generated encode function. For a SEQUENCE or a SET the index of the -%% component is counted. For a CHOICE the index is 2. -value_match(S,C,Name,SubAttr) -> - value_match(S,C,Name,SubAttr,[]). % C has name Name -value_match(_S,#'ComponentType'{},_Name,[],Acc) -> - Acc;% do not reverse, indexes in reverse order -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}); - Comps -> Comps - end, - {Index,ValueIndex} = component_value_index(S,InnerType,At,Components), - value_match(S,lists:nth(Index,Components),At,Ats,[ValueIndex|Acc]). - -component_value_index(S,'CHOICE',At,Components) -> - {component_index(S,At,Components),2}; -component_value_index(S,_,At,Components) -> - %% SEQUENCE or SET - Index = component_index(S,At,Components), - {Index,{Index+1,At}}. - -component_index(S,Name,Components) -> - component_index1(S,Name,Components,1). -component_index1(_S,Name,[#'ComponentType'{name=Name}|_Cs],N) -> - 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}). - -get_unique_fieldname(ClassDef) -> -%% {_,Fields,_} = ClassDef#classdef.typespec, - Fields = (ClassDef#classdef.typespec)#objectclass.fields, - get_unique_fieldname(Fields,[]). - -get_unique_fieldname([],[]) -> - throw({error,'__undefined_'}); -get_unique_fieldname([],[Name]) -> - Name; -get_unique_fieldname([],Acc) -> - throw({asn1,'only one UNIQUE field is allowed in CLASS',Acc}); -get_unique_fieldname([{fixedtypevaluefield,Name,_,'UNIQUE',_}|Rest],Acc) -> - get_unique_fieldname(Rest,[Name|Acc]); -get_unique_fieldname([_H|T],Acc) -> - get_unique_fieldname(T,Acc). - -get_tableconstraint_info(S,Type,{CheckedTs,EComps}) -> - {get_tableconstraint_info(S,Type,CheckedTs,[]), - get_tableconstraint_info(S,Type,EComps,[])}; -get_tableconstraint_info(S,Type,CheckedTs) -> - get_tableconstraint_info(S,Type,CheckedTs,[]). - -get_tableconstraint_info(_S,_Type,[],Acc) -> - lists:reverse(Acc); -get_tableconstraint_info(S,Type,[C|Cs],Acc) -> - CheckedTs = C#'ComponentType'.typespec, - AccComp = - case CheckedTs#type.def of - %% ObjectClassFieldType - OCFT=#'ObjectClassFieldType'{class=#objectclass{}, - type=_AType} -> -% AType = get_ObjectClassFieldType(S,Fields,FieldRef), -% RefedFieldName = -% get_referencedclassfield(CheckedTs#type.def),%is probably obsolete - NewOCFT = - OCFT#'ObjectClassFieldType'{class=[]}, - C#'ComponentType'{typespec= - CheckedTs#type{ -% def=AType, - def=NewOCFT - }}; -% constraint=[{tableconstraint_info, -% FieldRef}]}}; - {'SEQUENCE OF',SOType} when record(SOType,type), - (element(1,SOType#type.def)=='CHOICE') -> - CTypeList = element(2,SOType#type.def), - NewInnerCList = - get_tableconstraint_info(S,Type,CTypeList,[]), - C#'ComponentType'{typespec= - CheckedTs#type{ - def={'SEQUENCE OF', - SOType#type{def={'CHOICE', - NewInnerCList}}}}}; - {'SET OF',SOType} when record(SOType,type), - (element(1,SOType#type.def)=='CHOICE') -> - CTypeList = element(2,SOType#type.def), - NewInnerCList = - get_tableconstraint_info(S,Type,CTypeList,[]), - C#'ComponentType'{typespec= - CheckedTs#type{ - def={'SET OF', - SOType#type{def={'CHOICE', - NewInnerCList}}}}}; - _ -> - C - end, - get_tableconstraint_info(S,Type,Cs,[AccComp|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) -> - {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 - record(ERef,'Externaltypereference') -> - {_,Type} = get_referenced_type(S,ERef), - ClassSpec = check_class(S,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). - -check_PrimitiveFieldNames(_S,_Fields,_) -> - ok. - -%% get_ObjectClassFieldType_classdef gets the def of the class of the -%% ObjectClassFieldType, i.e. the objectclass record. If the type has -%% been checked (it may be a field type of an internal SEQUENCE) the -%% class field = [], then the classdef has to be fetched by help of -%% the class reference in the classname field. -get_ObjectClassFieldType_classdef(S,#'ObjectClassFieldType'{classname=Name, - class=[]}) -> - {_,#classdef{typespec=TS}} = get_referenced_type(S,Name), - TS; -get_ObjectClassFieldType_classdef(_,#'ObjectClassFieldType'{class=Cl}) -> - Cl. - -get_OCFType(S,Fields,[{_FieldType,PrimFieldName}|Rest]) -> - case lists:keysearch(PrimFieldName,2,Fields) of - {value,{fixedtypevaluefield,_,Type,_Unique,_OptSpec}} -> - {fixedtypevaluefield,PrimFieldName,Type}; - {value,{objectfield,_,Type,_Unique,_OptSpec}} -> - {_,ClassDef} = get_referenced_type(S,Type#type.def), - CheckedCDef = check_class(S#state{type=ClassDef, - tname=ClassDef#classdef.name}, - ClassDef#classdef.typespec), - get_OCFType(S,CheckedCDef#objectclass.fields,Rest); - {value,{objectsetfield,_,Type,_OptSpec}} -> - {_,ClassDef} = get_referenced_type(S,Type#type.def), - CheckedCDef = check_class(S#state{type=ClassDef, - tname=ClassDef#classdef.name}, - ClassDef#classdef.typespec), - get_OCFType(S,CheckedCDef#objectclass.fields,Rest); - - {value,Other} -> - {element(1,Other),PrimFieldName}; - _ -> - error({type,"undefined FieldName in ObjectClassFieldType",S}) - end. - -get_taglist(#state{erule=per},_) -> - []; -get_taglist(#state{erule=per_bin},_) -> - []; -get_taglist(S,Ext) when record(Ext,'Externaltypereference') -> - {_,T} = get_referenced_type(S,Ext), - get_taglist(S,T#typedef.typespec); -get_taglist(S,Tref) when record(Tref,typereference) -> - {_,T} = get_referenced_type(S,Tref), - get_taglist(S,T#typedef.typespec); -get_taglist(S,Type) when record(Type,type) -> - case Type#type.tag of - [] -> - get_taglist(S,Type#type.def); - [Tag|_] -> -% case lists:member(S#state.erule,[ber,ber_bin]) of -% true -> -% lists:map(fun(Tx) -> asn1ct_gen:def_to_tag(Tx) end,Type#type.tag); -% _ -> - [asn1ct_gen:def_to_tag(Tag)] -% end - end; -get_taglist(S,{'CHOICE',{Rc,Ec}}) -> - get_taglist(S,{'CHOICE',Rc ++ Ec}); -get_taglist(S,{'CHOICE',Components}) -> - get_taglist1(S,Components); -%% ObjectClassFieldType OTP-4390 -get_taglist(_S,#'ObjectClassFieldType'{type={typefield,_}}) -> - []; -get_taglist(S,#'ObjectClassFieldType'{type={fixedtypevaluefield,_,Type}}) -> - get_taglist(S,Type); -get_taglist(S,{ERef=#'Externaltypereference'{},FieldNameList}) - when list(FieldNameList) -> - case get_ObjectClassFieldType(S,ERef,FieldNameList) of - Type when record(Type,type) -> - get_taglist(S,Type); - {fixedtypevaluefield,_,Type} -> get_taglist(S,Type); - {TypeFieldName,_} when atom(TypeFieldName) -> []%should check if allowed - end; -get_taglist(S,{ObjCl,FieldNameList}) when record(ObjCl,objectclass), - list(FieldNameList) -> - case get_ObjectClassFieldType(S,ObjCl#objectclass.fields,FieldNameList) of - Type when record(Type,type) -> - get_taglist(S,Type); - {fixedtypevaluefield,_,Type} -> get_taglist(S,Type); - {TypeFieldName,_} when atom(TypeFieldName) -> []%should check if allowed - end; -get_taglist(S,Def) -> - case lists:member(S#state.erule,[ber_bin_v2]) of - false -> - case Def of - 'ASN1_OPEN_TYPE' -> % open_type has no UNIVERSAL tag as such - []; - _ -> - [asn1ct_gen:def_to_tag(Def)] - end; - _ -> - [] - end. - -get_taglist1(S,[#'ComponentType'{name=_Cname,tags=TagL}|Rest]) when list(TagL) -> - %% tag_list has been here , just return TagL and continue with next alternative - TagL ++ get_taglist1(S,Rest); -get_taglist1(S,[#'ComponentType'{typespec=Ts,tags=undefined}|Rest]) -> - get_taglist(S,Ts) ++ get_taglist1(S,Rest); -get_taglist1(S,[_H|Rest]) -> % skip EXTENSIONMARK - get_taglist1(S,Rest); -get_taglist1(_S,[]) -> - []. - -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 list(T2) -> - merge_tags2(T1 ++ T2, []); -merge_tags(T1, T2) -> - merge_tags2(T1 ++ [T2], []). - -merge_tags2([T1= #tag{type='IMPLICIT'}, T2 |Rest], Acc) -> - merge_tags2([T1#tag{type=T2#tag.type, form=T2#tag.form}|Rest],Acc); -merge_tags2([T1= #tag{type={default,'IMPLICIT'}}, T2 |Rest], Acc) -> - merge_tags2([T1#tag{type=T2#tag.type, form=T2#tag.form}|Rest],Acc); -merge_tags2([H|T],Acc) -> - merge_tags2(T, [H|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(M) when record(M,module) -> - TVlist = M#module.typeorval, - NewM = M#module{typeorval=findtypes_and_values(TVlist)}, - asn1_db:dbnew(NewM#module.name), - asn1_db:dbput(NewM#module.name,'MODULE', NewM), - Res = storeindb(NewM#module.name,TVlist,[]), - include_default_class(NewM#module.name), - include_default_type(NewM#module.name), - Res. - -storeindb(Module,[H|T],ErrAcc) when record(H,typedef) -> - storeindb(Module,H#typedef.name,H,T,ErrAcc); -storeindb(Module,[H|T],ErrAcc) when record(H,valuedef) -> - storeindb(Module,H#valuedef.name,H,T,ErrAcc); -storeindb(Module,[H|T],ErrAcc) when record(H,ptypedef) -> - storeindb(Module,H#ptypedef.name,H,T,ErrAcc); -storeindb(Module,[H|T],ErrAcc) when record(H,classdef) -> - storeindb(Module,H#classdef.name,H,T,ErrAcc); -storeindb(Module,[H|T],ErrAcc) when record(H,pvaluesetdef) -> - storeindb(Module,H#pvaluesetdef.name,H,T,ErrAcc); -storeindb(Module,[H|T],ErrAcc) when record(H,pobjectdef) -> - storeindb(Module,H#pobjectdef.name,H,T,ErrAcc); -storeindb(Module,[H|T],ErrAcc) when record(H,pvaluedef) -> - storeindb(Module,H#pvaluedef.name,H,T,ErrAcc); -storeindb(_,[],[]) -> ok; -storeindb(_,[],ErrAcc) -> - {error,ErrAcc}. - -storeindb(Module,Name,H,T,ErrAcc) -> - case asn1_db:dbget(Module,Name) of - undefined -> - asn1_db:dbput(Module,Name,H), - storeindb(Module,T,ErrAcc); - _ -> - case H of - _Type when record(H,typedef) -> - error({type,"already defined", - #state{mname=Module,type=H,tname=Name}}); - _Type when record(H,valuedef) -> - error({value,"already defined", - #state{mname=Module,value=H,vname=Name}}); - _Type when record(H,ptypedef) -> - error({ptype,"already defined", - #state{mname=Module,type=H,tname=Name}}); - _Type when record(H,pobjectdef) -> - error({ptype,"already defined", - #state{mname=Module,type=H,tname=Name}}); - _Type when record(H,pvaluesetdef) -> - error({ptype,"already defined", - #state{mname=Module,type=H,tname=Name}}); - _Type when record(H,pvaluedef) -> - error({ptype,"already defined", - #state{mname=Module,type=H,tname=Name}}); - _Type when record(H,classdef) -> - error({class,"already defined", - #state{mname=Module,value=H,vname=Name}}) - end, - storeindb(Module,T,[H|ErrAcc]) - end. - -findtypes_and_values(TVList) -> - findtypes_and_values(TVList,[],[],[],[],[],[]).%% Types,Values, -%% Parameterizedtypes,Classes,Objects and ObjectSets - -findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) - when record(H,typedef),record(H#typedef.typespec,'Object') -> - findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,[H#typedef.name|Oacc],OSacc); -findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) - when record(H,typedef),record(H#typedef.typespec,'ObjectSet') -> - findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,Oacc,[H#typedef.name|OSacc]); -findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) - when record(H,typedef) -> - findtypes_and_values(T,[H#typedef.name|Tacc],Vacc,Pacc,Cacc,Oacc,OSacc); -findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) - when record(H,valuedef) -> - findtypes_and_values(T,Tacc,[H#valuedef.name|Vacc],Pacc,Cacc,Oacc,OSacc); -findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) - when record(H,ptypedef) -> - findtypes_and_values(T,Tacc,Vacc,[H#ptypedef.name|Pacc],Cacc,Oacc,OSacc); -findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) - when record(H,classdef) -> - findtypes_and_values(T,Tacc,Vacc,Pacc,[H#classdef.name|Cacc],Oacc,OSacc); -findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) - when record(H,pvaluedef) -> - findtypes_and_values(T,Tacc,[H#pvaluedef.name|Vacc],Pacc,Cacc,Oacc,OSacc); -findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) - when record(H,pvaluesetdef) -> - findtypes_and_values(T,Tacc,[H#pvaluesetdef.name|Vacc],Pacc,Cacc,Oacc,OSacc); -findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) - when record(H,pobjectdef) -> - findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,[H#pobjectdef.name|Oacc],OSacc); -findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) - when record(H,pobjectsetdef) -> - findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,Oacc,[H#pobjectsetdef.name|OSacc]); -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)}. - - - -error({export,Msg,#state{mname=Mname,type=Ref,tname=Typename}}) -> - Pos = Ref#'Externaltypereference'.pos, - io:format("asn1error:~p:~p:~p ~p~n",[Pos,Mname,Typename,Msg]), - {error,{export,Pos,Mname,Typename,Msg}}; -error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}}) - when record(Type,typedef) -> - io:format("asn1error:~p:~p:~p ~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 record(Type,ptypedef) -> - io:format("asn1error:~p:~p:~p ~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 record(Value,valuedef) -> - io:format("asn1error:~p:~p:~p ~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 record(Type,pobjectdef) -> - io:format("asn1error:~p:~p:~p ~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}}) -> - io:format("asn1error:~p:~p:~p ~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 ~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 ~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 ~p~n",[Pos,Mname,Typename,Msg]), - {error,{Other,Pos,Mname,Typename,Msg}}. - -include_default_type(Module) -> - NameAbsList = default_type_list(), - include_default_type1(Module,NameAbsList). - -include_default_type1(_,[]) -> - ok; -include_default_type1(Module,[{Name,TS}|Rest]) -> - case asn1_db:dbget(Module,Name) of - undefined -> - T = #typedef{name=Name, - typespec=TS}, - asn1_db:dbput(Module,Name,T); - _ -> ok - end, - include_default_type1(Module,Rest). - -default_type_list() -> - %% The EXTERNAL type is represented, according to ASN.1 1997, - %% as a SEQUENCE with components: identification, data-value-descriptor - %% and data-value. - Syntax = - #'ComponentType'{name=syntax, - typespec=#type{def='OBJECT IDENTIFIER'}, - prop=mandatory}, - Presentation_Cid = - #'ComponentType'{name='presentation-context-id', - typespec=#type{def='INTEGER'}, - prop=mandatory}, - Transfer_syntax = - #'ComponentType'{name='transfer-syntax', - typespec=#type{def='OBJECT IDENTIFIER'}, - prop=mandatory}, - Negotiation_items = - #type{def= - #'SEQUENCE'{components= - [Presentation_Cid, - Transfer_syntax#'ComponentType'{prop=mandatory}]}}, - Context_negot = - #'ComponentType'{name='context-negotiation', - typespec=Negotiation_items, - prop=mandatory}, - - Data_value_descriptor = - #'ComponentType'{name='data-value-descriptor', - typespec=#type{def='ObjectDescriptor'}, - prop='OPTIONAL'}, - Data_value = - #'ComponentType'{name='data-value', - typespec=#type{def='OCTET STRING'}, - prop=mandatory}, - - %% The EXTERNAL type is represented, according to ASN.1 1990, - %% as a SEQUENCE with components: direct-reference, indirect-reference, - %% data-value-descriptor and encoding. - - Direct_reference = - #'ComponentType'{name='direct-reference', - typespec=#type{def='OBJECT IDENTIFIER'}, - prop='OPTIONAL'}, - - Indirect_reference = - #'ComponentType'{name='indirect-reference', - typespec=#type{def='INTEGER'}, - prop='OPTIONAL'}, - - Single_ASN1_type = - #'ComponentType'{name='single-ASN1-type', - typespec=#type{tag=[{tag,'CONTEXT',0, - 'EXPLICIT',32}], - def='ANY'}, - prop=mandatory}, - - Octet_aligned = - #'ComponentType'{name='octet-aligned', - typespec=#type{tag=[{tag,'CONTEXT',1, - 'IMPLICIT',32}], - def='OCTET STRING'}, - prop=mandatory}, - - Arbitrary = - #'ComponentType'{name=arbitrary, - typespec=#type{tag=[{tag,'CONTEXT',2, - 'IMPLICIT',32}], - def={'BIT STRING',[]}}, - prop=mandatory}, - - Encoding = - #'ComponentType'{name=encoding, - typespec=#type{def={'CHOICE', - [Single_ASN1_type,Octet_aligned, - Arbitrary]}}, - prop=mandatory}, - - EXTERNAL_components1990 = - [Direct_reference,Indirect_reference,Data_value_descriptor,Encoding], - - %% The EMBEDDED PDV type is represented by a SEQUENCE type - %% with components: identification and data-value - Abstract = - #'ComponentType'{name=abstract, - typespec=#type{def='OBJECT IDENTIFIER'}, - prop=mandatory}, - Transfer = - #'ComponentType'{name=transfer, - typespec=#type{def='OBJECT IDENTIFIER'}, - prop=mandatory}, - AbstractTrSeq = - #'SEQUENCE'{components=[Abstract,Transfer]}, - Syntaxes = - #'ComponentType'{name=syntaxes, - typespec=#type{def=AbstractTrSeq}, - prop=mandatory}, - Fixed = #'ComponentType'{name=fixed, - typespec=#type{def='NULL'}, - prop=mandatory}, - Negotiations = - [Syntaxes,Syntax,Presentation_Cid,Context_negot, - Transfer_syntax,Fixed], - Identification2 = - #'ComponentType'{name=identification, - typespec=#type{def={'CHOICE',Negotiations}}, - prop=mandatory}, - EmbeddedPdv_components = - [Identification2,Data_value], - - %% The CHARACTER STRING type is represented by a SEQUENCE type - %% with components: identification and string-value - String_value = - #'ComponentType'{name='string-value', - typespec=#type{def='OCTET STRING'}, - prop=mandatory}, - CharacterString_components = - [Identification2,String_value], - - [{'EXTERNAL', - #type{tag=[#tag{class='UNIVERSAL', - number=8, - type='IMPLICIT', - form=32}], - def=#'SEQUENCE'{components= - EXTERNAL_components1990}}}, - {'EMBEDDED PDV', - #type{tag=[#tag{class='UNIVERSAL', - number=11, - type='IMPLICIT', - form=32}], - def=#'SEQUENCE'{components=EmbeddedPdv_components}}}, - {'CHARACTER STRING', - #type{tag=[#tag{class='UNIVERSAL', - number=29, - type='IMPLICIT', - form=32}], - def=#'SEQUENCE'{components=CharacterString_components}}} - ]. - - -include_default_class(Module) -> - NameAbsList = default_class_list(), - include_default_class1(Module,NameAbsList). - -include_default_class1(_,[]) -> - ok; -include_default_class1(Module,[{Name,TS}|_Rest]) -> - case asn1_db:dbget(Module,Name) of - undefined -> - C = #classdef{checked=true,name=Name, - typespec=TS}, - asn1_db:dbput(Module,Name,C); - _ -> ok - end. - -default_class_list() -> - [{'TYPE-IDENTIFIER', - {objectclass, - [{fixedtypevaluefield, - id, - {type,[],'OBJECT IDENTIFIER',[]}, - 'UNIQUE', - 'MANDATORY'}, - {typefield,'Type','MANDATORY'}], - {'WITH SYNTAX', - [{typefieldreference,'Type'}, - 'IDENTIFIED', - 'BY', - {valuefieldreference,id}]}}}, - {'ABSTRACT-SYNTAX', - {objectclass, - [{fixedtypevaluefield, - id, - {type,[],'OBJECT IDENTIFIER',[]}, - 'UNIQUE', - 'MANDATORY'}, - {typefield,'Type','MANDATORY'}, - {fixedtypevaluefield, - property, - {type, - [], - {'BIT STRING',[]}, - []}, - undefined, - {'DEFAULT', - [0,1,0]}}], - {'WITH SYNTAX', - [{typefieldreference,'Type'}, - 'IDENTIFIED', - 'BY', - {valuefieldreference,id}, - ['HAS', - 'PROPERTY', - {valuefieldreference,property}]]}}}]. - |