← Back to branch summary

~rdoering/ubuntu/karmic/erlang/fix-535090

« back to all changes in this revision

Viewing changes to lib/asn1/src/asn1ct_check.erl

  • Committer: Bazaar Package Importer
  • Author(s): Sergei Golovan
  • Date: 2009-02-15 16:42:52 UTC
  • mfrom: (3.1.2 squeeze)
  • Revision ID: james.westby@ubuntu.com-20090215164252-q5x4rcf8a5pbesb1
Tags: 1:12.b.5-dfsg-2
Upload to unstable after lenny is released.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/asn1/src/asn1ct_check.erl
1
 
%% ``The contents of this file are subject to the Erlang Public License,
 
1
%%<copyright>
 
2
%% <year>1997-2008</year>
 
3
%% <holder>Ericsson AB, All Rights Reserved</holder>
 
4
%%</copyright>
 
5
%%<legalnotice>
 
6
%% The contents of this file are subject to the Erlang Public License,
2
7
%% Version 1.1, (the "License"); you may not use this file except in
3
8
%% compliance with the License. You should have received a copy of the
4
9
%% Erlang Public License along with this software. If not, it can be
5
 
%% retrieved via the world wide web at http://www.erlang.org/.
6
 
%% 
 
10
%% retrieved online at http://www.erlang.org/.
 
11
%%
7
12
%% Software distributed under the License is distributed on an "AS IS"
8
13
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
9
14
%% the License for the specific language governing rights and limitations
10
15
%% under the License.
11
 
%% 
12
 
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
13
 
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
14
 
%% AB. All Rights Reserved.''
15
 
%% 
16
 
%%     $Id$
 
16
%%
 
17
%% The Initial Developer of the Original Code is Ericsson AB.
 
18
%%</legalnotice>
17
19
%%
18
20
-module(asn1ct_check).
19
21
 
37
39
-define(N_ENUMERATED, 10).   
38
40
-define(N_EMBEDDED_PDV, 11). % constructed
39
41
-define(N_UTF8String, 12).
 
42
-define('N_RELATIVE-OID',13).
40
43
-define(N_SEQUENCE, 16). 
41
44
-define(N_SET, 17). 
42
45
-define(N_NumericString, 18).
84
87
 
85
88
    %% initialize internal book keeping
86
89
    save_asn1db_uptodate(S,S#state.erule,S#state.mname),
 
90
    put(top_module,S#state.mname),
87
91
 
88
92
    _Perror = checkp(S,ParameterizedTypes,[]), % must do this before the templates are used
89
93
    
90
94
    %% table to save instances of parameterized objects,object sets
91
95
    asn1ct:create_ets_table(parameterized_objects,[named_table]),
 
96
    asn1ct:create_ets_table(inlined_objects,[named_table]),
 
97
 
92
98
 
93
99
    Terror = checkt(S,Types,[]),
94
100
    ?dbg("checkt finished with errors:~n~p~n~n",[Terror]),
132
138
 
133
139
    {ValueSetNames,Verror5} = filter_errors(IsValueSet,Verror4),
134
140
 
135
 
    asn1ct:create_ets_table(inlined_objects,[named_table]),
136
 
 
137
141
    {Oerror,ExclO,ExclOS} = checko(S,NewObjects ++
138
142
                                   NewObjectSets,
139
143
                                   [],[],[]),
153
157
 
154
158
    Exporterror = check_exports(S,S#state.module),
155
159
    ImportError = check_imports(S,S#state.module),
 
160
 
156
161
    case {Terror3,Verror5,Cerror,Oerror,Exporterror,ImportError} of
157
162
        {[],[],[],[],[],[]} -> 
158
163
            ContextSwitchTs = context_switch_in_spec(),
214
219
            L
215
220
    end.
216
221
 
 
222
put_once(T,State) ->
 
223
    %% state is one of undefined, unchecked, generate
 
224
    %% undefined > unchecked > generate
 
225
    case get(T) of
 
226
        PrevS when PrevS > State ->
 
227
            put(T,State);
 
228
        _ ->
 
229
            ok
 
230
    end.
 
231
 
217
232
filter_errors(Pred,ErrorList) ->
218
233
    Element2 = fun(X) -> element(2,X) end,
219
234
    RemovedTupleElements = lists:filter(Pred,ErrorList),
270
285
        end,
271
286
    Module = NameOfDef(ModuleRef),
272
287
    Refs = [{M,R}||{{M,_},R} <- [{catch get_referenced_type(S,Ref),Ref}||Ref <- Imports]],
273
 
    IllegalRefs = [R||{M,R} <- Refs, M =/= Module],
 
288
    {Illegal,Other} = lists:splitwith(fun({error,_}) -> true;(_) -> false end,
 
289
                                      Refs),
 
290
    ChainedRefs = [R||{M,R} <- Other, M =/= Module],
 
291
    IllegalRefs = [R||{error,R} <- Illegal] ++ 
 
292
        [R||{M,R} <- ChainedRefs, 
 
293
            ok =/= chained_import(S,Module,M,NameOfDef(R))],
274
294
    ReportError =
275
295
        fun(Ref) ->
276
296
                NewS=S#state{type=Ref,tname=NameOfDef(Ref)},
278
298
        end,
279
299
    check_imports2(S,SFMs,[ReportError(Err)||Err <- IllegalRefs]++Acc).
280
300
 
 
301
chained_import(S,ImpMod,DefMod,Name) ->
 
302
    %% Name is a referenced structure that is not defined in ImpMod,
 
303
    %% but must be present in the Imports list of ImpMod. The chain of
 
304
    %% imports of Name must end in DefMod.
 
305
    NameOfDef =
 
306
        fun(#'Externaltypereference'{type=N}) -> N;
 
307
           (#'Externalvaluereference'{value=N}) -> N;
 
308
           (Other) -> Other
 
309
        end,
 
310
    GetImports =
 
311
        fun(_M_) ->
 
312
                case asn1_db:dbget(_M_,'MODULE') of
 
313
                    #module{imports={imports,ImportList}} ->
 
314
                        ImportList;
 
315
                    _ -> []
 
316
                end
 
317
        end,
 
318
    FindNameInImports =
 
319
        fun([],N,_) -> {no_mod,N};
 
320
           ([#'SymbolsFromModule'{symbols=Imports,module=ModuleRef}|SFMs],N,F) ->
 
321
                case [NameOfDef(X)||X <- Imports, NameOfDef(X) =:= N] of
 
322
                    [] -> F(SFMs,N,F);
 
323
                    [N] -> {NameOfDef(ModuleRef),N}
 
324
                end
 
325
        end,
 
326
    case GetImports(ImpMod) of
 
327
        [] ->
 
328
            error;
 
329
        Imps ->
 
330
            case FindNameInImports(Imps,Name,FindNameInImports) of
 
331
                {no_mod,_} ->
 
332
                    error;
 
333
                {DefMod,_} -> ok;
 
334
                {OtherMod,_} ->
 
335
                    chained_import(S,OtherMod,DefMod,Name)
 
336
            end
 
337
    end.
281
338
                          
282
339
checkt(S,[Name|T],Acc) ->
283
340
    ?dbg("Checking type ~p~n",[Name]),
364
421
                             %% this is an object, save as typedef
365
422
                             #valuedef{checked=C,pos=Pos,name=N,type=Type,
366
423
                                       value=Def}=Value,
367
 
%                            Currmod = S#state.mname,
368
 
%                            #type{def=
369
 
%                                  #'Externaltypereference'{module=Mod,
370
 
%                                                           type=CName}} = Type,
371
 
                             ClassName =
372
 
                                 Type#type.def,
373
 
%                                case Mod of
374
 
%                                    Currmod ->
375
 
%                                        {objectclassname,CName};
376
 
%                                    _ ->
377
 
%                                        {objectclassname,Mod,CName}
378
 
%                                end,
 
424
                             ClassName = Type#type.def,
379
425
                             NewSpec = #'Object'{classname=ClassName,
380
426
                                                 def=Def},
381
427
                             NewDef = #typedef{checked=C,pos=Pos,name=N,
660
706
                    end,
661
707
                case Cat of
662
708
                    Class when record(Class,classdef) ->
663
 
                        {objectfield,Name,Type,Unique,OSpec};
 
709
                        %% Type must be a referenced type => change it
 
710
                        %% to an external reference.
 
711
                        ToExt = fun(#type{def= CE = #'Externaltypereference'{}}) -> CE; (T) -> T end,
 
712
                        {objectfield,Name,ToExt(Type),Unique,OSpec};
664
713
                    _ ->
665
714
                        RefType = check_type(S,#typedef{typespec=Type},Type),   
666
715
                        {fixedtypevaluefield,Name,RefType,Unique,OSpec}
761
810
    ObjSpec;
762
811
check_object(S,_ObjDef,#'Object'{classname=ClassRef,def=ObjectDef}) ->
763
812
    ?dbg("check_object ~p~n",[ObjectDef]),
 
813
%%    io:format("check_object,object: ~p~n",[ObjectDef]),
764
814
%    {MName,_ClassDef} = get_referenced_type(S,ClassRef),
765
815
    NewClassRef = check_externaltypereference(S,ClassRef),
766
816
    ClassDef =
796
846
                %% Maybe this call should be catched and in case of an exception
797
847
                %% a not initialized parameterized object should be returned.
798
848
                instantiate_po(S,ClassDef,Object,ArgsList);
 
849
            {pv,{simpledefinedvalue,ObjRef},ArgList} ->
 
850
                {_,Object} = get_referenced_type(S,ObjRef),
 
851
                instantiate_po(S,ClassDef,Object,ArgList);
799
852
            #'Externalvaluereference'{} ->
800
853
                {_,Object} = get_referenced_type(S,ObjectDef),
801
854
                check_object(S,Object,Object#typedef.typespec);
816
869
check_object(S,
817
870
             _ObjSetDef,
818
871
             ObjSet=#'ObjectSet'{class=ClassRef}) ->
 
872
%%    io:format("check_object,SET: ~p~n",[ObjSet#'ObjectSet'.set]),
819
873
    ?dbg("check_object set: ~p~n",[ObjSet#'ObjectSet'.set]),
820
874
    {_,ClassDef} = get_referenced_type(S,ClassRef),
821
875
    NewClassRef = check_externaltypereference(S,ClassRef),
822
 
    UniqueFieldName = 
823
 
        case (catch get_unique_fieldname(ClassDef)) of
824
 
            {error,'__undefined_'} -> {unique,undefined};
 
876
    %% XXXXXXXXXX
 
877
    case ObjSet of
 
878
        #'ObjectSet'{set={'Externaltypereference',undefined,'MSAccessProtocol',
 
879
                     'AllOperations'}} ->
 
880
            ok;
 
881
        _ ->
 
882
            ok
 
883
    end,
 
884
    {UniqueFieldName,UniqueInfo} = 
 
885
        case (catch get_unique_fieldname(S,ClassDef)) of
 
886
            {error,'__undefined_',_} -> 
 
887
                {{unique,undefined},{unique,undefined}};
825
888
            {asn1,Msg,_} -> error({class,Msg,S});
826
 
            Other -> Other
 
889
            {'EXIT',Msg} -> error({class,{internal_error,Msg},S});
 
890
            Other -> {element(1,Other),Other}
827
891
        end,
828
892
    NewObjSet=
829
893
        case prepare_objset(ObjSet#'ObjectSet'.set) of
830
894
            {set,SET,EXT} ->
831
895
                CheckedSet = check_object_list(S,NewClassRef,SET),
832
 
                NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName),
 
896
                NewSet = get_unique_valuelist(S,CheckedSet,UniqueInfo),
833
897
                ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
834
898
                                   set=extensionmark(NewSet,EXT)};
835
899
 
836
 
            {'SingleValue',{definedvalue,ObjName}} ->
837
 
                {RefedMod,ObjDef} = 
838
 
                    get_referenced_type(S,#identifier{val=ObjName}),
839
 
                #'Object'{def=CheckedObj} = 
840
 
                    check_object(S,ObjDef,ObjDef#typedef.typespec),
841
 
 
842
 
                NewSet = get_unique_valuelist(S,[{{RefedMod,get_datastr_name(ObjDef)}, CheckedObj}],
843
 
                                              UniqueFieldName),
844
 
                ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
845
 
                                   set=NewSet};
846
 
            {'SingleValue',#'Externalvaluereference'{value=ObjName}} ->
847
 
                {RefedMod,ObjDef} = get_referenced_type(S,#identifier{val=ObjName}),
 
900
            {'SingleValue',ERef = #'Externalvaluereference'{}} ->
 
901
                {RefedMod,ObjDef} = get_referenced_type(S,ERef),
848
902
                #'Object'{def=CheckedObj} = 
849
903
                    check_object(S,ObjDef,ObjDef#typedef.typespec),
850
904
 
851
905
                NewSet = get_unique_valuelist(S,[{{RefedMod,get_datastr_name(ObjDef)},
852
906
                                                  CheckedObj}],
853
 
                                              UniqueFieldName),
 
907
                                              UniqueInfo),
854
908
                ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
855
909
                                   set=NewSet};
856
910
            ['EXTENSIONMARK'] ->
857
911
                ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
858
912
                                   set=['EXTENSIONMARK']};
859
913
 
 
914
            OSref when is_record(OSref,'Externaltypereference') ->
 
915
                {_,OS=#typedef{typespec=OSdef}} = get_referenced_type(S,OSref),
 
916
                check_object(S,OS,OSdef);
 
917
 
860
918
            {Type,{'EXCEPT',Exclusion}} when record(Type,type) ->
861
919
                {_,TDef} = get_referenced_type(S,Type#type.def),
862
920
                OS = TDef#typedef.typespec,
876
934
            %% field.
877
935
            #type{def=#'ObjectClassFieldType'{classname=ObjName,
878
936
                                              fieldname=FieldName}} ->
879
 
                {_,TDef} = get_referenced_type(S,ObjName),
 
937
                {RefedObjMod,TDef} = get_referenced_type(S,ObjName),
880
938
                OS=TDef#typedef.typespec,
881
939
                %% should get the right object set here. Get the field
882
940
                %% FieldName out of the object set OS of class
883
941
                %% OS#'ObjectSet'.class
884
942
                OS2=check_object(S,TDef,OS),
885
 
                NewSet=object_set_from_objects(S,FieldName,OS2),
 
943
                NewSet=object_set_from_objects(S,RefedObjMod,FieldName,OS2),
886
944
                ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
887
945
                                   set=NewSet};
888
946
            {'ObjectSetFromObjects',{_,_,ObjName},FieldName} ->
889
 
                {_,TDef} = get_referenced_type(S,ObjName),
 
947
                {RefedObjMod,TDef} = get_referenced_type(S,ObjName),
890
948
                OS=TDef#typedef.typespec,
891
949
                %% should get the right object set here. Get the field
892
950
                %% FieldName out of the object set OS of class
893
951
                %% OS#'ObjectSet'.class
894
952
                OS2=check_object(S,TDef,OS),
895
 
                NewSet=object_set_from_objects(S,FieldName,OS2),
 
953
                NewSet=object_set_from_objects(S,RefedObjMod,FieldName,OS2),
896
954
                ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
897
955
                                   set=NewSet};
898
956
             {'ObjectSetFromObjects',{_,ObjName},FieldName} ->
900
958
                %% ObjectSetFromObjects ::= ReferencedObjects "." FieldName
901
959
                %% with a defined object as ReferencedObjects. And
902
960
                %% the FieldName of the Class (object) contains an object set.
903
 
                {_,TDef} = get_referenced_type(S,ObjName),
 
961
                {RefedObjMod,TDef} = get_referenced_type(S,ObjName),
904
962
                O1 = TDef#typedef.typespec,
905
963
                O2 = check_object(S,TDef,O1),
906
 
                NewSet = object_set_from_objects(S,FieldName,O2),
 
964
                NewSet = object_set_from_objects(S,RefedObjMod,FieldName,O2),
907
965
                OS2=ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
908
966
                                   set=NewSet},
909
967
                %%io:format("ObjectSet: ~p~n",[OS2]),
910
 
                OS2
 
968
                OS2;
 
969
            {pos,{objectset,_,DefinedObjSet},Params} ->
 
970
                {_,PObjSetDef} = get_referenced_type(S,DefinedObjSet),
 
971
                NewParamList = 
 
972
                    [match_parameters(S,TmpParam,S#state.parameters)|| 
 
973
                        TmpParam <- Params],
 
974
                instantiate_pos(S,ClassRef,PObjSetDef,NewParamList);
 
975
            Unknown ->
 
976
                exit({error,{unknown_object_set,Unknown},S})
911
977
        end,
912
 
    Gen = gen_incl_set(S,NewObjSet#'ObjectSet'.set,
 
978
    NewSet2 = remove_duplicate_objects(NewObjSet#'ObjectSet'.set),
 
979
    NewObjSet2 = NewObjSet#'ObjectSet'{set=NewSet2},
 
980
    Gen = gen_incl_set(S,NewObjSet2#'ObjectSet'.set,
913
981
                       ClassDef),
914
982
    ?dbg("check_object done~n",[]),
915
 
    NewObjSet#'ObjectSet'{class=NewClassRef,gen=Gen}.
 
983
    NewObjSet2#'ObjectSet'{class=NewClassRef,gen=Gen}.
 
984
 
 
985
%% remove_duplicate_objects/1 remove duplicates of objects.
 
986
%% For instance may Set contain objects of same class from
 
987
%% different object sets that in fact might be duplicates.
 
988
remove_duplicate_objects(Set) when is_list(Set) ->
 
989
    Pred = fun({A,B,_},{A,C,_}) when B =< C -> true;
 
990
              ({A,_,_},{B,_,_}) when A < B -> true;
 
991
              ('EXTENSIONMARK','EXTENSIONMARK') -> true;
 
992
              (T,A) when is_tuple(T),is_atom(A) -> true;% EXTENSIONMARK last in list
 
993
              (_,_) -> false 
 
994
           end,
 
995
    lists:usort(Pred,Set).
916
996
 
917
997
%%
918
998
extensionmark(L,true) ->
923
1003
extensionmark(L,_) ->
924
1004
    L.
925
1005
 
 
1006
object_to_check(#typedef{typespec=ObjDef}) ->
 
1007
    ObjDef;
 
1008
object_to_check(#valuedef{type=ClassName,value=ObjectRef}) ->
 
1009
    %% If the object definition is parsed as an object the ClassName
 
1010
    %% is parsed as a type
 
1011
    #'Object'{classname=ClassName#type.def,def=ObjectRef}.
 
1012
 
926
1013
prepare_objset({'SingleValue',Set}) when is_list(Set) ->
927
1014
    {set,Set,false};
928
1015
prepare_objset(L=['EXTENSIONMARK']) ->
968
1055
%% is the union of object sets if the last field name is an object
969
1056
%% set.  If the last field is an object the resulting object set is
970
1057
%% the set of objects in ObjectSet.
971
 
object_set_from_objects(S,FieldName,ObjectSet) when is_record(ObjectSet,'ObjectSet') ->
 
1058
object_set_from_objects(S,RefedObjMod,FieldName,ObjectSet) ->
 
1059
    object_set_from_objects(S,RefedObjMod,FieldName,ObjectSet,[]).
 
1060
object_set_from_objects(S,RefedObjMod,FieldName,ObjectSet,InterSect)
 
1061
  when is_record(ObjectSet,'ObjectSet') ->
972
1062
    #'ObjectSet'{class=Cl,set=Set} = ObjectSet,
973
1063
    {_,ClassDef} = get_referenced_type(S,Cl),
974
 
    object_set_from_objects(S,ClassDef,FieldName,Set,[]);
975
 
object_set_from_objects(S,FieldName,Object) when is_record(Object,'Object') ->
 
1064
    object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,Set,InterSect,[]);
 
1065
object_set_from_objects(S,RefedObjMod,FieldName,Object,InterSect) 
 
1066
  when is_record(Object,'Object') ->
976
1067
    #'Object'{classname=Cl,def=Def}=Object,
977
 
    object_set_from_objects(S,Cl,FieldName,[Def],[]).
978
 
object_set_from_objects(S,ClassDef,FieldName,[O|Os],Acc) ->
979
 
    case object_set_from_objects2(S,ClassDef,FieldName,element(3,O)) of
 
1068
    object_set_from_objects(S,RefedObjMod,Cl,FieldName,[Def],InterSect,[]).
 
1069
object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,['EXTENSIONMARK'|Os],
 
1070
                        InterSect,Acc) ->
 
1071
    object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,Os,InterSect,%%Acc);
 
1072
                            ['EXTENSIONMARK'|Acc]);
 
1073
object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,[O|Os],InterSect,Acc) ->
 
1074
    case object_set_from_objects2(S,mod_of_obj(RefedObjMod,element(1,O)),
 
1075
                                  ClassDef,FieldName,element(3,O),InterSect) of
980
1076
        ObjS when list(ObjS) ->
981
 
            object_set_from_objects(S,ClassDef,FieldName,Os,ObjS++Acc);
 
1077
            object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,Os,InterSect,ObjS++Acc);
982
1078
        Obj ->
983
 
            object_set_from_objects(S,ClassDef,FieldName,Os,[Obj|Acc])
 
1079
            object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,Os,InterSect,[Obj|Acc])
984
1080
    end;
985
 
object_set_from_objects(_S,_ClassDef,_FieldName,[],Acc) ->
 
1081
object_set_from_objects(_S,_RefedObjMod,_ClassDef,_FieldName,[],InterSect,Acc) ->
986
1082
    %% For instance may Acc contain objects of same class from
987
1083
    %% different object sets that in fact might be duplicates.
988
 
    Pred = fun({A,B,_},{A,C,_}) when B =< C -> true;
989
 
              ({A,_,_},{B,_,_}) when A < B -> true;
990
 
              (_,_) -> false 
991
 
           end,
992
 
    lists:usort(Pred,Acc).
 
1084
    remove_duplicate_objects(osfo_intersection(InterSect,Acc)).
993
1085
%%    Acc.
994
 
object_set_from_objects2(S,ClassDef,[{valuefieldreference,OName}],
995
 
                         Fields) ->
 
1086
object_set_from_objects2(S,RefedObjMod,ClassDef,[{valuefieldreference,OName}],
 
1087
                         Fields,_InterSect) ->
996
1088
    %% this is an object
997
1089
    case lists:keysearch(OName,1,Fields) of
998
1090
        {value,{_,TDef}} ->
999
 
            #'Object'{classname=_NextClName,def=ODef}=TDef#typedef.typespec,
1000
 
            {_,_,NextFields}=ODef,
1001
 
%%          {_,NextClass} = get_referenced_type(S,NextClName),
1002
 
            UniqueFieldName = 
1003
 
                case (catch get_unique_fieldname(ClassDef)) of
1004
 
                    {error,'__undefined_'} -> {unique,undefined};
1005
 
                    {asn1,Msg,_} -> error({class,Msg,S});
1006
 
                    Other -> Other
1007
 
                end,
1008
 
            VDef = get_unique_value(S,NextFields,UniqueFieldName),
1009
 
            {get_datastr_name(TDef),VDef,NextFields};
 
1091
            mk_object_set_from_object(S,RefedObjMod,TDef,ClassDef);
1010
1092
        _ ->
1011
1093
            [] % it may be an absent optional field
1012
1094
    end;
1013
 
object_set_from_objects2(_S,_ClassDef,[{typefieldreference,OSName}],
1014
 
                        Fields) ->
 
1095
object_set_from_objects2(S,RefedObjMod,ClassDef,[{typefieldreference,OSName}],
 
1096
                        Fields,_InterSect) ->
1015
1097
    %% this is an object set
1016
1098
    case lists:keysearch(OSName,1,Fields) of
1017
1099
        {value,{_,TDef}} ->
1018
 
            #'ObjectSet'{class=_NextClName,set=NextSet} = TDef#typedef.typespec,
1019
 
            NextSet;
 
1100
            case TDef#typedef.typespec of
 
1101
                #'ObjectSet'{class=_NextClName,set=NextSet} ->%% = TDef#typedef.typespec,
 
1102
                    NextSet;
 
1103
                #'Object'{def=_ObjDef} ->
 
1104
                    mk_object_set_from_object(S,RefedObjMod,TDef,ClassDef)
 
1105
%%                  ObjDef
 
1106
                    %% error({error,{internal,unexpected_object,TDef}})
 
1107
            end;
1020
1108
        _ ->
1021
1109
            [] % it may be an absent optional field
1022
1110
    end;
1023
 
object_set_from_objects2(S,_ClassDef,[{valuefieldreference,OName}|Rest],
1024
 
                         Fields) ->
 
1111
object_set_from_objects2(S,RefedObjMod,_ClassDef,[{valuefieldreference,OName}|Rest],
 
1112
                         Fields,InterSect) ->
1025
1113
    %% this is an object
1026
1114
    case lists:keysearch(OName,1,Fields) of
1027
1115
        {value,{_,TDef}} ->
1028
1116
            #'Object'{classname=NextClName,def=ODef}=TDef#typedef.typespec,
1029
1117
            {_,_,NextFields}=ODef,
1030
1118
            {_,NextClass} = get_referenced_type(S,NextClName),
1031
 
            object_set_from_objects2(S,NextClass,Rest,NextFields);
 
1119
            object_set_from_objects2(S,RefedObjMod,NextClass,Rest,NextFields,InterSect);
1032
1120
        _ ->
1033
1121
            []
1034
1122
    end;
1035
 
object_set_from_objects2(S,_ClassDef,[{typefieldreference,OSName}|Rest],
1036
 
                        Fields) ->
 
1123
object_set_from_objects2(S,RefedObjMod,_ClassDef,[{typefieldreference,OSName}|Rest],
 
1124
                        Fields,InterSect) ->
1037
1125
    %% this is an object set
1038
 
    case lists:keysearch(OSName,1,Fields) of
1039
 
        {value,{_,TDef}} ->    
1040
 
            #'ObjectSet'{class=NextClName,set=NextSet} = TDef,
 
1126
    Next = {NextClName,NextSet} = 
 
1127
        case lists:keysearch(OSName,1,Fields) of
 
1128
            {value,{_,TDef}} when is_record(TDef,'ObjectSet') ->    
 
1129
                #'ObjectSet'{class=NextClN,set=NextS} = TDef,
 
1130
                {NextClN,NextS};
 
1131
            {value,{_,#typedef{typespec=OS}}} ->
 
1132
                %% objectsets in defined syntax will come here as typedef{}
 
1133
                %% #'ObjectSet'{class=NextClN,set=NextS} = OS,
 
1134
                case OS of
 
1135
                    #'ObjectSet'{class=NextClN,set=NextS} ->
 
1136
                        {NextClN,NextS};
 
1137
                    #'Object'{classname=NextClN,def=NextDef} ->
 
1138
                        {NextClN,[NextDef]}
 
1139
                end;
 
1140
        _ ->
 
1141
            {[],[]}
 
1142
    end,
 
1143
    case Next of
 
1144
        {[],[]} ->
 
1145
            [];
 
1146
        _ ->
1041
1147
            {_,NextClass} = get_referenced_type(S,NextClName),
1042
 
            object_set_from_objects(S,NextClass,Rest,NextSet,[]);
1043
 
        _ ->
1044
 
            []
 
1148
            object_set_from_objects(S,RefedObjMod,NextClass,Rest,NextSet,InterSect,[])
1045
1149
    end.
1046
 
 
1047
 
    
1048
1150
                
1049
 
            
 
1151
mk_object_set_from_object(S,RefedObjMod,TDef,Class) -> 
 
1152
    #'Object'{classname=_NextClName,def=ODef} = TDef#typedef.typespec,
 
1153
    {_,_,NextFields}=ODef,
 
1154
 
 
1155
    UniqueFieldName = 
 
1156
        case (catch get_unique_fieldname(S,Class)) of
 
1157
            {error,'__undefined_',_} -> {unique,undefined};
 
1158
            {asn1,Msg,_} -> error({class,Msg,S});
 
1159
            {'EXIT',Msg} -> error({class,{internal_error,Msg},S});
 
1160
            {Other,_} -> Other
 
1161
        end,
 
1162
    VDef = get_unique_value(S,NextFields,UniqueFieldName),
 
1163
    %% XXXXXXXXXXX
 
1164
    case VDef of
 
1165
        [] ->
 
1166
            ['EXTENSIONMARK'];
 
1167
        _ ->
 
1168
            {{RefedObjMod,get_datastr_name(TDef)},VDef,NextFields}    
 
1169
    end.
 
1170
    
 
1171
    
 
1172
mod_of_obj(_RefedObjMod,{NewMod,ObjName}) 
 
1173
  when is_atom(NewMod),is_atom(ObjName) ->
 
1174
    NewMod;
 
1175
mod_of_obj(RefedObjMod,_) ->
 
1176
    RefedObjMod.
1050
1177
    
1051
1178
 
1052
1179
merge_sets(Root,{'SingleValue',Ext}) ->
1086
1213
                             #'Object'{classname=ClassRef,
1087
1214
                                       def=ObjDef}),
1088
1215
            check_object_list(S,ClassRef,Objs,[{{no_mod,no_name},Def#'Object'.def}|Acc]);
1089
 
        {'SingleValue',{definedvalue,ObjName}} ->
1090
 
            {RefedMod,ObjectDef} = get_referenced_type(S,#identifier{val=ObjName}),
1091
 
            #'Object'{def=Def} = check_object(S,ObjectDef,ObjectDef#typedef.typespec),
1092
 
            check_object_list(S,ClassRef,Objs,
1093
 
                              [{{RefedMod,get_datastr_name(ObjectDef)},Def}|Acc]);
1094
1216
        {'SingleValue',Ref = #'Externalvaluereference'{}} ->
1095
 
            {RefedMod,ObjectDef} = get_referenced_type(S,Ref),
1096
 
            #'Object'{def=Def} = check_object(S,ObjectDef,ObjectDef#typedef.typespec),
1097
 
            check_object_list(S,ClassRef,Objs,
1098
 
                              [{{RefedMod,get_datastr_name(ObjectDef)},Def}|Acc]);
 
1217
            ?dbg("{SingleValue,Externalvaluereference}~n",[]),
 
1218
            {RefedMod,ObjName,
 
1219
             #'Object'{def=Def}} = check_referenced_object(S,Ref),
 
1220
            check_object_list(S,ClassRef,Objs,[{{RefedMod,ObjName},Def}|Acc]);
1099
1221
        ObjRef when record(ObjRef,'Externalvaluereference') ->
1100
1222
            ?dbg("Externalvaluereference~n",[]),
1101
 
            {RefedMod,ObjectDef} = get_referenced_type(S,ObjRef),
1102
 
            ?dbg("Externalvaluereference, ObjectDef: ~p~n",[ObjectDef]),
1103
 
            #'Object'{def=Def} = check_object(S,ObjectDef,ObjectDef#typedef.typespec),
1104
 
            check_object_list(S,ClassRef,Objs,
1105
 
                              [{{RefedMod,get_datastr_name(ObjectDef)},Def}|Acc]);
 
1223
            {RefedMod,ObjName,
 
1224
             #'Object'{def=Def}} = check_referenced_object(S,ObjRef),
 
1225
             check_object_list(S,ClassRef,Objs,[{{RefedMod,ObjName},Def}|Acc]);
1106
1226
        {'ValueFromObject',{_,Object},FieldName} ->
1107
1227
            {_,Def} = get_referenced_type(S,Object),
1108
1228
            TypeDef = get_fieldname_element(S,Def,FieldName),
1123
1243
            check_object_list(S,ClassRef,Objs,AccList++Acc);
1124
1244
        union ->
1125
1245
            check_object_list(S,ClassRef,Objs,Acc);
 
1246
        {pos,{objectset,_,DefinedObjectSet},Params} ->
 
1247
            OSDef = #type{def={pt,DefinedObjectSet,Params}},
 
1248
            #'ObjectSet'{set=Set} =
 
1249
                check_object(S,ObjOrSet,#'ObjectSet'{class=ClassRef,
 
1250
                                                     set=OSDef}),
 
1251
            check_object_list(S,ClassRef,Objs,Set ++ Acc);
1126
1252
        {pv,{simpledefinedvalue,DefinedObject},Params} ->
1127
1253
            Args = [match_parameters(S,Param,S#state.parameters)||
1128
1254
                       Param<-Params],
1132
1258
                                       def={po,{object,DefinedObject},
1133
1259
                                            Args}}),
1134
1260
            check_object_list(S,ClassRef,Objs,[{{no_mod,no_name},Def}|Acc]);
 
1261
        {'ObjectSetFromObjects',Os,FieldName} when is_tuple(Os) ->
 
1262
            NewSet =
 
1263
                check_ObjectSetFromObjects(S,element(size(Os),Os),
 
1264
                                           FieldName,[]),
 
1265
            check_object_list(S,ClassRef,Objs,NewSet++Acc);
 
1266
        {{'ObjectSetFromObjects',Os,FieldName},InterSection}
 
1267
        when is_tuple(Os) ->
 
1268
            NewSet =
 
1269
                check_ObjectSetFromObjects(S, element(size(Os),Os),
 
1270
                                           FieldName,InterSection),
 
1271
            check_object_list(S,ClassRef,Objs,NewSet++Acc);
1135
1272
        Other ->
1136
1273
            exit({error,{'unknown object',Other},S})
1137
1274
    end;
1140
1277
%% list.
1141
1278
check_object_list(_,_,[],Acc) ->
1142
1279
    lists:reverse(Acc).
1143
 
        
 
1280
 
 
1281
check_referenced_object(S,ObjRef) 
 
1282
  when is_record(ObjRef,'Externalvaluereference')->
 
1283
    case get_referenced_type(S,ObjRef) of
 
1284
        {RefedMod,ObjectDef} when is_record(ObjectDef,valuedef) ->      
 
1285
            ?dbg("Externalvaluereference, ObjectDef: ~p~n",[ObjectDef]),
 
1286
            #type{def=ClassRef} = ObjectDef#valuedef.type,
 
1287
            Def = ObjectDef#valuedef.value,
 
1288
            {RefedMod,get_datastr_name(ObjectDef),
 
1289
             check_object(update_state(S,RefedMod),ObjectDef,#'Object'{classname=ClassRef,
 
1290
                                                def=Def})};
 
1291
        {RefedMod,ObjectDef} when is_record(ObjectDef,typedef) ->
 
1292
            {RefedMod,get_datastr_name(ObjectDef),
 
1293
             check_object(update_state(S,RefedMod),ObjectDef,ObjectDef#typedef.typespec)}
 
1294
    end.
 
1295
 
 
1296
check_ObjectSetFromObjects(S,ObjName,FieldName,InterSection) ->
 
1297
    {RefedMod,TDef} = get_referenced_type(S,ObjName),
 
1298
    ObjOrSet = check_object(update_state(S,RefedMod),TDef,TDef#typedef.typespec),
 
1299
    InterSec = prepare_intersection(S,InterSection),
 
1300
    _NewSet = object_set_from_objects(S,RefedMod,FieldName,ObjOrSet,InterSec).
 
1301
 
 
1302
prepare_intersection(_S,[]) ->
 
1303
    [];
 
1304
prepare_intersection(S,{'EXCEPT',ObjRef}) ->
 
1305
    except_names(S,ObjRef);
 
1306
prepare_intersection(_S,T) ->
 
1307
    exit({error,{internal_error,not_implemented,object_set_from_objects,T}}).
 
1308
except_names(_S,{'SingleValue',#'Externalvaluereference'{value=ObjName}})  ->
 
1309
    [{except,ObjName}];
 
1310
except_names(_,T) ->
 
1311
    exit({error,{internal_error,not_implemented,object_set_from_objects,T}}).
 
1312
 
 
1313
osfo_intersection(InterSect,ObjList) ->
 
1314
    Res = [X|| X = {{_,N},_,_} <- ObjList,
 
1315
               lists:member({except,N},InterSect) == false],
 
1316
    case lists:member('EXTENSIONMARK',ObjList) of
 
1317
        true ->
 
1318
            Res ++ ['EXTENSIONMARK'];
 
1319
        _ ->
 
1320
            Res
 
1321
    end.
1144
1322
 
1145
1323
%%  get_fieldname_element/3
1146
1324
%%  gets the type/value/object/... of the referenced element in FieldName
1150
1328
%%  Def is the def of the first object referenced by FieldName
1151
1329
get_fieldname_element(S,Def,[{_RefType,FieldName}]) when record(Def,typedef) ->
1152
1330
    {_,_,ObjComps} = (Def#typedef.typespec)#'Object'.def,
1153
 
    case lists:keysearch(FieldName,1,ObjComps) of
1154
 
        {value,{_,TDef}} when record(TDef,typedef) ->
1155
 
            TDef;
1156
 
        {value,{_,VDef}} when record(VDef,valuedef) ->
1157
 
            check_value(S,VDef);
 
1331
    check_fieldname_element(S,lists:keysearch(FieldName,1,ObjComps));
 
1332
get_fieldname_element(S,Def,[{_RefType,FieldName}|Rest])
 
1333
  when record(Def,typedef) ->
 
1334
    %% As FieldName is followd by other FieldNames it has to be an
 
1335
    %% object or objectset.
 
1336
    {_,_,ObjComps} = (Def#typedef.typespec)#'Object'.def,
 
1337
    NewDef = check_fieldname_element(S,lists:keysearch(FieldName,1,ObjComps)),
 
1338
    ObjDef = fun(#'Object'{def=D}) -> D;
 
1339
                (#'ObjectSet'{set=Set}) -> Set
 
1340
             end 
 
1341
               (NewDef),
 
1342
    case ObjDef of
 
1343
        L when is_list(L) ->
 
1344
            [get_fieldname_element(S,X,Rest) || X <- L];
1158
1345
        _ ->
1159
 
            throw({assigned_object_error,"not_assigned_object",S})
 
1346
            get_fieldname_element(S,ObjDef,Rest)
1160
1347
    end;
 
1348
get_fieldname_element(S,{object,_,Fields},[{_RefType,FieldName}|Rest]) ->
 
1349
    NewDef = check_fieldname_element(S,lists:keysearch(FieldName,1,Fields)),
 
1350
    get_fieldname_element(S,NewDef,Rest);
 
1351
get_fieldname_element(_S,Def,[]) -> 
 
1352
    Def;
1161
1353
get_fieldname_element(_S,Def,[{_RefType,_FieldName}|_RestFName]) 
1162
1354
  when record(Def,typedef) ->
1163
1355
    ok.
 
1356
 
 
1357
check_fieldname_element(S,{value,{_,Def}}) ->
 
1358
    check_fieldname_element(S,Def);
 
1359
check_fieldname_element(S,TDef)  when is_record(TDef,typedef) ->
 
1360
    check_type(S,TDef,TDef#typedef.typespec);
 
1361
check_fieldname_element(S,VDef) when is_record(VDef,valuedef) ->
 
1362
    check_value(S,VDef);
 
1363
check_fieldname_element(S,Eref)
 
1364
  when is_record(Eref,'Externaltypereference');
 
1365
       is_record(Eref,'Externalvaluereference') ->
 
1366
    {_,TDef}=get_referenced_type(S,Eref),
 
1367
    check_fieldname_element(S,TDef);
 
1368
check_fieldname_element(S,Other) ->
 
1369
    throw({error,{assigned_object_error,"not_assigned_object",Other,S}}).
1164
1370
    
1165
1371
transform_set_to_object_list([{Name,_UVal,Fields}|Objs],Acc) ->
1166
1372
    transform_set_to_object_list(Objs,[{Name,{object,generatesyntax,Fields}}|Acc]);
1171
1377
    Acc.
1172
1378
 
1173
1379
get_unique_valuelist(_S,ObjSet,{unique,undefined}) -> % no unique field in object
1174
 
    lists:map(fun({N,{_,_,F}})->{N,F};
1175
 
                 (V={_,_,_}) ->V end, ObjSet);
1176
 
get_unique_valuelist(S,ObjSet,UFN) ->
1177
 
    get_unique_vlist(S,ObjSet,UFN,[]).
1178
 
 
1179
 
 
1180
 
get_unique_vlist(_S,[],_,[]) ->
 
1380
    lists:map(fun({N,{_,_,F}})->{N,no_unique_value,F};
 
1381
                 (V={_,_,_}) ->V;
 
1382
                 ({A,B}) -> {A,no_unique_value,B} 
 
1383
              end, ObjSet);
 
1384
get_unique_valuelist(S,ObjSet,{UFN,Opt}) ->
 
1385
    get_unique_vlist(S,ObjSet,UFN,Opt,[]).
 
1386
 
 
1387
 
 
1388
get_unique_vlist(_S,[],_,_,[]) ->
1181
1389
    ['EXTENSIONMARK'];
1182
 
get_unique_vlist(S,[],_,Acc) ->
1183
 
    case catch check_uniqueness(Acc) of
 
1390
get_unique_vlist(S,[],_,Opt,Acc) ->
 
1391
    case catch check_uniqueness(remove_duplicate_objects(Acc)) of
 
1392
        {asn1_error,_} when Opt =/= 'OPTIONAL' ->
 
1393
            error({'ObjectSet',"not unique objects in object set",S});
1184
1394
        {asn1_error,_} ->
1185
 
%           exit({error,Reason,S});
1186
 
            error({'ObjectSet',"not unique objects in object set",S});
1187
 
        true ->
 
1395
            lists:reverse(Acc);
 
1396
        _ ->
1188
1397
            lists:reverse(Acc)
1189
1398
    end;
1190
 
get_unique_vlist(S,[{ObjName,Obj}|Rest],UniqueFieldName,Acc) ->
 
1399
get_unique_vlist(S,['EXTENSIONMARK'|Rest],UniqueFieldName,Opt,Acc) ->
 
1400
    get_unique_vlist(S,Rest,UniqueFieldName,Opt,Acc);
 
1401
get_unique_vlist(S,[{ObjName,Obj}|Rest],UniqueFieldName,Opt,Acc) ->
1191
1402
    {_,_,Fields} = Obj,
1192
 
%    VDef = get_unique_value(S,Fields,UniqueFieldName),
1193
1403
    NewObjInf = 
1194
1404
        case get_unique_value(S,Fields,UniqueFieldName) of
1195
1405
            #valuedef{value=V} -> [{ObjName,V,Fields}];
1197
1407
                     % empty object set.
1198
1408
            no_unique_value -> [{ObjName,no_unique_value,Fields}]
1199
1409
        end,
1200
 
    get_unique_vlist(S,Rest,UniqueFieldName,NewObjInf++Acc);
1201
 
%                    [{ObjName,VDef#valuedef.value,Fields}|Acc]);
 
1410
    get_unique_vlist(S,Rest,UniqueFieldName,Opt,NewObjInf++Acc);
1202
1411
 
1203
 
get_unique_vlist(S,[V={_,_,_}|Rest],UniqueFieldName,Acc) ->
1204
 
    get_unique_vlist(S,Rest,UniqueFieldName,[V|Acc]).
 
1412
get_unique_vlist(S,[V={_,_,_}|Rest],UniqueFieldName,Opt,Acc) ->
 
1413
    get_unique_vlist(S,Rest,UniqueFieldName,Opt,[V|Acc]).
1205
1414
 
1206
1415
get_unique_value(S,Fields,UniqueFieldName) ->
1207
1416
    Module = S#state.mname,
1210
1419
            case element(2,Field) of
1211
1420
                VDef when record(VDef,valuedef) ->
1212
1421
                    VDef;
1213
 
                {definedvalue,ValName} ->
1214
 
                    ValueDef = asn1_db:dbget(Module,ValName),
1215
 
                    case ValueDef of
1216
 
                        VDef when record(VDef,valuedef) ->
1217
 
                            ValueDef;
1218
 
                        undefined -> 
1219
 
                            #valuedef{value=ValName}
1220
 
                    end;
1221
1422
                {'ValueFromObject',Object,Name} ->
1222
1423
                    case Object of
1223
1424
                        {object,Ext} when record(Ext,'Externaltypereference') ->
1235
1436
                                         Object},S})
1236
1437
                    end;
1237
1438
                Value when atom(Value);number(Value) ->
1238
 
                    #valuedef{value=Value};
1239
 
                {'CHOICE',{_,Value}} when atom(Value);number(Value) ->
1240
 
                    #valuedef{value=Value}
 
1439
                    #valuedef{value=Value,module=Module};
 
1440
                {'CHOICE',{C,Value}} when atom(C) ->
 
1441
                    %% #valuedef{value=normalize_value(S,element(3,Field),VDef,[])}
 
1442
                    case Value of
 
1443
                        Scalar when is_atom(Scalar);is_number(Scalar) ->
 
1444
                            #valuedef{value=Value,module=Module};
 
1445
                        Eref = #'Externalvaluereference'{} ->
 
1446
                            element(2,get_referenced_type(S,Eref))
 
1447
                    end
1241
1448
            end;
1242
1449
        false ->
1243
1450
            case Fields of
1245
1452
                    [];
1246
1453
                _ ->
1247
1454
                    no_unique_value
1248
 
%%                  exit({error,{'no unique value',Fields,UniqueFieldName},S})
1249
1455
            end
1250
1456
    end.
1251
1457
 
1310
1516
gen_incl1(S,Fields,[C|CFields]) ->
1311
1517
    case element(1,C) of
1312
1518
        typefield ->
1313
 
%           case lists:keymember(element(2,C),1,Fields) of
1314
 
%               true ->
1315
 
%                   true;
1316
 
%               false ->
1317
 
%                   gen_incl1(S,Fields,CFields)
1318
 
%           end;
1319
1519
            true; %% should check that field is OPTIONAL or DEFUALT if
1320
1520
                  %% the object lacks this field
1321
1521
        objectfield ->
1322
1522
            case lists:keysearch(element(2,C),1,Fields) of
1323
1523
                {value,Field} ->
1324
 
                    Type = element(3,C),
1325
 
                    {_,ClassDef} = get_referenced_type(S,Type#type.def),
1326
 
%                   {_,ClassFields,_} = ClassDef#classdef.typespec,
1327
 
                    #objectclass{fields=ClassFields} = 
1328
 
                        ClassDef#classdef.typespec,
1329
 
%%                  ObjTDef = 
1330
 
%%                      case element(2,Field) of
1331
 
%%                          TDef when record(TDef,typedef) -> TDef;
1332
 
%%                          ERef ->
1333
 
%%                              {_,T} = get_referenced_type(S,ERef),
1334
 
%%                              T
1335
 
%%                      end,
 
1524
                    ClassRef = case element(3,C) of
 
1525
                              #type{def=Ref} -> Ref;
 
1526
                              Eref when is_record(Eref,'Externaltypereference') ->
 
1527
                                  Eref
 
1528
                          end,
 
1529
                    ClassFields = get_objclass_fields(S,ClassRef),
1336
1530
                    ObjDef = 
1337
1531
                        case element(2,Field) of
1338
1532
                            TDef when record(TDef,typedef) -> 
1339
1533
                                check_object(S,TDef,TDef#typedef.typespec);
1340
1534
                            ERef ->
1341
1535
                                {_,T} = get_referenced_type(S,ERef),
1342
 
                                check_object(S,T,T#typedef.typespec)
 
1536
                                check_object(S,T,object_to_check(T))
1343
1537
                        end,
1344
 
%%                  case gen_incl(S,(ObjTDef#typedef.typespec)#'Object'.def,
1345
1538
                    case gen_incl(S,ObjDef#'Object'.def,
1346
1539
                                  ClassFields) of
1347
1540
                        true ->
1356
1549
            gen_incl1(S,Fields,CFields)
1357
1550
    end.
1358
1551
 
 
1552
get_objclass_fields(S,Eref=#'Externaltypereference'{}) ->
 
1553
    {_,ClassDef} = get_referenced_type(S,Eref),
 
1554
    get_objclass_fields(S,ClassDef);
 
1555
get_objclass_fields(S,CD=#classdef{typespec=#'Externaltypereference'{}}) ->
 
1556
    get_objclass_fields(S,CD#classdef.typespec);
 
1557
get_objclass_fields(_,#classdef{typespec=CDef}) 
 
1558
  when is_record(CDef,objectclass) ->
 
1559
    CDef#objectclass.fields.
 
1560
    
 
1561
 
1359
1562
%% first if no unique field in the class return false.(don't generate code)
 
1563
gen_incl_set(S,Fields,#typedef{typespec=#type{def=Eref}}) 
 
1564
  when is_record(Eref,'Externaltypereference') ->
 
1565
    %% When a Defined class is a reference toanother class definition
 
1566
    {_,CDef} = get_referenced_type(S,Eref),
 
1567
    gen_incl_set(S,Fields,CDef);
1360
1568
gen_incl_set(S,Fields,ClassDef) ->
1361
 
    case catch get_unique_fieldname(ClassDef) of
1362
 
        Tuple when tuple(Tuple) ->
 
1569
    case catch get_unique_fieldname(S,ClassDef) of
 
1570
        Tuple when tuple(Tuple), size(Tuple) =:= 3 ->
1363
1571
            false;
1364
1572
        _ ->
1365
1573
            gen_incl_set1(S,Fields,
1366
1574
                          (ClassDef#classdef.typespec)#objectclass.fields)
1367
1575
    end.
1368
1576
 
 
1577
 
1369
1578
%% if any of the existing or potentially existing objects has a typefield
1370
1579
%% then return true.
1371
1580
gen_incl_set1(_,[],_CFields)->
1374
1583
    true;
1375
1584
%% Fields are the fields of an object in the object set.
1376
1585
%% CFields are the fields of the class of the object set.
 
1586
gen_incl_set1(_,['EXTENSIONMARK'|_],_) ->
 
1587
    true;
1377
1588
gen_incl_set1(S,[Object|Rest],CFields)->
1378
1589
    Fields = element(size(Object),Object),
1379
1590
    case gen_incl1(S,Fields,CFields) of
1461
1672
%% An additional optional field within an optional field
1462
1673
match_optional_field(S,Fields,[W|Ws],ClassFields,Ret) when list(W) ->
1463
1674
    case catch match_optional_field(S,Fields,W,ClassFields,[]) of
 
1675
        {'EXIT',_} when length(Ws) > 0 ->
 
1676
            match_optional_field(S,Fields,Ws,ClassFields,Ret);
1464
1677
        {'EXIT',_} ->
1465
1678
            {Ret,Fields};
 
1679
        {asn1,{optional_matcherror,_,_}} when length(Ws) > 0 ->
 
1680
            match_optional_field(S,Fields,Ws,ClassFields,Ret);
1466
1681
        {asn1,{optional_matcherror,_,_}} ->
1467
1682
            {Ret,Fields};
1468
1683
        {OptionalField,RestFields} ->
1470
1685
                                 lists:append(OptionalField,Ret))
1471
1686
    end;
1472
1687
%% identify and skip word
1473
 
%match_optional_field(S,[#'Externaltypereference'{type=WorS}|Rest],
1474
 
%match_optional_field(S,[{_,_,WorS}|Rest],
1475
1688
match_optional_field(S,[{_,_,#'Externaltypereference'{type=WorS}}|Rest],
1476
1689
                     [WorS|Ws],ClassFields,Ret) ->
1477
1690
    match_optional_field(S,Rest,Ws,ClassFields,Ret);
1490
1703
    WorS =
1491
1704
        case Setting of
1492
1705
            Type when record(Type,type) -> Type;
1493
 
%%          #'Externalvaluereference'{value=WordOrSetting} -> WordOrSetting;
1494
1706
            {'ValueFromObject',_,_} -> Setting;
1495
1707
            {object,_,_} -> Setting;
1496
1708
            {_,_,WordOrSetting} -> WordOrSetting;
1497
 
%%          Atom when atom(Atom) -> Atom
1498
1709
            Other -> Other
1499
1710
        end,
1500
1711
    case lists:keysearch(W,2,ClassFields) of
1532
1743
    ?dbg("matching field setting: ~p with user friendly syntax: ~p~n",[Setting,W]),
1533
1744
    WorS = 
1534
1745
        case Setting of
1535
 
%%          Atom when atom(Atom) -> Atom;
1536
 
%%          #'Externalvaluereference'{value=WordOrSetting} -> WordOrSetting;
1537
1746
            {object,_,_} -> Setting;
1538
1747
            {_,_,WordOrSetting} -> WordOrSetting;
1539
1748
            Type when record(Type,type) -> Type;
1554
1763
%% Converts a field of an object from defined syntax to default syntax
1555
1764
%% A field may be a type, a fixed type value, an object, an objectset,
1556
1765
%% 
1557
 
convert_to_defaultfield(S,ObjFieldName,[ObjFieldSetting|RestSettings],CField)->
 
1766
convert_to_defaultfield(S,ObjFieldName,[OFS|RestOFS],CField)->
1558
1767
    ?dbg("convert field: ~p of type: ~p~n",[ObjFieldName,element(1,CField)]),
1559
1768
    CurrMod = S#state.mname,
 
1769
    Strip_value_tag = 
 
1770
        fun({value_tag,ValueSetting}) -> ValueSetting;
 
1771
           (VS) -> VS
 
1772
        end,
 
1773
    ObjFieldSetting = Strip_value_tag(OFS),
 
1774
    RestSettings = [Strip_value_tag(X)||X <- RestOFS],
1560
1775
    case element(1,CField) of
1561
1776
        typefield ->
1562
1777
            TypeDef=
1563
1778
                case ObjFieldSetting of
1564
 
                    TypeRec when record(TypeRec,type) -> TypeRec#type.def;
1565
 
                    TDef when record(TDef,typedef) -> 
 
1779
                    TypeRec when is_record(TypeRec,type) -> TypeRec#type.def;
 
1780
                    TDef when is_record(TDef,typedef) -> 
1566
1781
                        TDef#typedef{checked=true,
1567
1782
                                     typespec=check_type(S,TDef,
1568
1783
                                                         TDef#typedef.typespec)};
1570
1785
                end,
1571
1786
            {Type,SettingsLeft} = 
1572
1787
                if
1573
 
                    record(TypeDef,typedef) -> {TypeDef,RestSettings};
1574
 
                    record(TypeDef,'ObjectClassFieldType') ->
 
1788
                    is_record(TypeDef,typedef) -> {TypeDef,RestSettings};
 
1789
                    is_record(TypeDef,'ObjectClassFieldType') ->
1575
1790
                        T=check_type(S,#typedef{typespec=ObjFieldSetting},ObjFieldSetting),
1576
1791
                        {oCFT_def(S,T),RestSettings};
1577
1792
%                       #typedef{checked=true,name=Name,typespec=IT};
1578
 
                    tuple(TypeDef), element(1,TypeDef) == pt  ->
 
1793
                    is_tuple(TypeDef), element(1,TypeDef) == pt  ->
1579
1794
                        %% this is an inlined type. If constructed
1580
1795
                        %% type save in data base
1581
1796
                        T=check_type(S,#typedef{typespec=ObjFieldSetting},ObjFieldSetting),
1586
1801
                        NewTDef=#typedef{checked=true,name=NewName,
1587
1802
                                         typespec=T},
1588
1803
                        asn1_db:dbput(S#state.mname,NewName,NewTDef),
1589
 
                        asn1ct_gen:insert_once(parameterized_objects,{NewName,type,NewTDef}),
 
1804
                        %%asn1ct_gen:insert_once(parameterized_objects,{NewName,type,NewTDef}),
 
1805
                        insert_once(S,parameterized_objects,
 
1806
                                    {NewName,type,NewTDef}),
1590
1807
                        {NewTDef,RestSettings};
1591
 
                    tuple(TypeDef), element(1,TypeDef)=='SelectionType'  ->
 
1808
                    is_tuple(TypeDef), element(1,TypeDef)=='SelectionType'  ->
1592
1809
                        T=check_type(S,#typedef{typespec=ObjFieldSetting},
1593
1810
                                     ObjFieldSetting),
1594
1811
                        Name = type_name(S,T),
1597
1814
                        case asn1ct_gen:type(asn1ct_gen:get_inner(TypeDef)) of
1598
1815
                            ERef = #'Externaltypereference'{module=CurrMod} ->
1599
1816
                                {RefMod,T} = get_referenced_type(S,ERef),
1600
 
%                               Settings2Ret = 
1601
 
                                    check_and_save(S,ERef#'Externaltypereference'{module=RefMod},T,RestSettings);
1602
 
%                               {ERef#'Externaltypereference'{module=RefMod},Settings2Ret};
 
1817
                                check_and_save(S,ERef#'Externaltypereference'{module=RefMod},T,RestSettings);
 
1818
 
1603
1819
                            ERef = #'Externaltypereference'{} ->
1604
1820
                                {RefMod,T} = get_referenced_type(S,ERef),
1605
 
                                NewS = S#state{module=load_asn1_module(S,RefMod),
1606
 
                                               mname=RefMod,
1607
 
                                               type=T,
1608
 
                                               tname=get_datastr_name(T)},
1609
 
                                check_type(NewS,T,T#typedef.typespec),
1610
 
                                {merged_name(S,ERef),RestSettings};
 
1821
                                check_and_save(S,ERef#'Externaltypereference'{module=RefMod},T,RestSettings);
1611
1822
                            Bif when Bif=={primitive,bif};Bif=={constructed,bif} ->
1612
1823
                                T = check_type(S,#typedef{typespec=ObjFieldSetting},
1613
1824
                                               ObjFieldSetting),
1614
1825
                                {#typedef{checked=true,name=Bif,typespec=T},RestSettings};
1615
 
                            OCFT = #'ObjectClassFieldType'{} ->
 
1826
                            _OCFT = #'ObjectClassFieldType'{} ->
1616
1827
                                T=check_type(S,#typedef{typespec=ObjFieldSetting},ObjFieldSetting),
1617
 
                                io:format("OCFT=~p~n,T=~p~n",[OCFT,T]),
 
1828
                                %%io:format("OCFT=~p~n,T=~p~n",[OCFT,T]),
1618
1829
                                {#typedef{checked=true,typespec=T},RestSettings};
1619
1830
                            _ ->
1620
1831
                                %this case should not happen any more
1637
1848
                    %% an element in an enumeration or namednumberlist etc.
1638
1849
                    ValRef =
1639
1850
                        case ObjFieldSetting of
1640
 
                            #'Externalvaluereference'{} -> ObjFieldSetting;
 
1851
                            ValSetting=#'Externalvaluereference'{} ->
 
1852
                                ValSetting;
1641
1853
                            {'ValueFromObject',{_,ObjRef},FieldName} ->
1642
1854
                                {_,Object} = get_referenced_type(S,ObjRef),
1643
1855
                                ChObject = check_object(S,Object,
1644
1856
                                                        Object#typedef.typespec),
1645
1857
                                get_fieldname_element(S,Object#typedef{typespec=ChObject},
1646
1858
                                                      FieldName);
1647
 
                            #valuedef{} ->
1648
 
                                ObjFieldSetting;
1649
 
                            _ ->
1650
 
                                #identifier{val=ObjFieldSetting}
 
1859
                            ValSetting = #valuedef{} ->
 
1860
                                ValSetting;
 
1861
                            ValSetting = {'CHOICE',{Alt,_ChVal}} when is_atom(Alt) ->
 
1862
                                        #valuedef{type=element(3,CField),
 
1863
                                                  value=ValSetting,
 
1864
                                                  module=S#state.mname};
 
1865
                            ValSetting ->
 
1866
                                #identifier{val=ValSetting}
1651
1867
                        end,
1652
1868
                    ?dbg("fixedtypevaluefield ValRef: ~p~n",[ValRef]),
1653
1869
                    case ValRef of
1657
1873
                            ValDef =
1658
1874
                                case catch get_referenced_type(S,ValRef) of
1659
1875
                                    {error,_} ->
1660
 
                                        check_value(S,#valuedef{name=Val,
1661
 
                                                                type=element(3,CField),
1662
 
                                                                value=ObjFieldSetting});
 
1876
                                        NewValDef =
 
1877
                                            #valuedef{name=Val,
 
1878
                                                      type=element(3,CField),
 
1879
                                                      value=ObjFieldSetting,
 
1880
                                                      module=S#state.mname},
 
1881
                                        check_value(S,NewValDef);
1663
1882
                                    {M,VDef} when record(VDef,valuedef) ->
1664
1883
                                        check_value(update_state(S,M),
1665
1884
                                                    %%S#state{mname=M},
1669
1888
                                                    %%S#state{mname=M},
1670
1889
                                                    #valuedef{name=Val,
1671
1890
                                                              type=element(3,CField),
1672
 
                                                              value=VDef})
 
1891
                                                              value=VDef,
 
1892
                                                              module=M})
1673
1893
                                end,
1674
1894
                            {{ObjFieldName,ValDef},RestSettings}
1675
1895
                    end;
1686
1906
                end,
1687
1907
            ObjectSpec = 
1688
1908
                case ObjFieldSetting of
1689
 
%                   Ref when record(Ref,typereference);record(Ref,identifier);
1690
 
%                            record(Ref,'Externaltypereference');
1691
 
%                            record(Ref,'Externalvaluereference') ->
1692
1909
                    Ref when record(Ref,'Externalvaluereference') ->
1693
 
                        {M,O} = get_referenced_type(S,ObjFieldSetting),
1694
 
                        check_object(S,O,O#typedef.typespec),
 
1910
                        %% The object O might be a #valuedef{} if
 
1911
                        %% e.g. the definition looks like 
 
1912
                        %% myobj SOMECLASS ::= referencedObject
 
1913
                        {M,O} = get_referenced_type(S,Ref),
 
1914
                        check_object(S,O,object_to_check(O)),
1695
1915
                        Ref#'Externalvaluereference'{module=M};
1696
 
%                       R;
 
1916
 
1697
1917
                    {'ValueFromObject',{_,ObjRef},FieldName} ->
1698
1918
                        %% This is an ObjectFromObject
1699
1919
                        {_,Object} = get_referenced_type(S,ObjRef),
1704
1924
                                                      typespec=ChObject},
1705
1925
                                                  FieldName),
1706
1926
                        CheckObject(ObjFromObj);
1707
 
                    {object,_,_} ->
 
1927
                    ObjDef={object,_,_} ->
1708
1928
                        %% An object defined inlined in another object
1709
 
                        #type{def=Ref} = element(3,CField),
 
1929
                        %% class is an objectfield, that implies that 
 
1930
                        %% {objectsetfield,TypeFieldName,DefinedObjecClass,
 
1931
                        %%  OptionalitySpec}
 
1932
                        %% DefinedObjecClass = #'Externaltypereference'{}|
 
1933
                        %% 'TYPE-IDENTIFIER' | 'ABSTRACT-SYNTAX'
 
1934
                        ClassName = element(3,CField),
1710
1935
                        InlinedObjName=
1711
1936
                            list_to_atom(lists:concat([S#state.tname]++
1712
1937
                                                      ['_',ObjFieldName])),
1713
1938
 
1714
 
                        ObjSpec = #'Object'{classname=Ref,
1715
 
                                            def=ObjFieldSetting},
 
1939
                        ObjSpec = #'Object'{classname=ClassName,
 
1940
                                            def=ObjDef},
1716
1941
                        CheckedObj=
1717
1942
                            check_object(S,#typedef{typespec=ObjSpec},ObjSpec),
1718
1943
                        InlObj = #typedef{checked=true,name=InlinedObjName,
1719
1944
                                          typespec=CheckedObj},
1720
 
                        asn1ct_gen:insert_once(inlined_objects,{InlinedObjName,
1721
 
                                                                InlinedObjName}),
1722
 
                        asn1_db:dbput(S#state.mname,InlinedObjName,InlObj),
 
1945
                        ObjKey = {InlinedObjName,InlinedObjName},
 
1946
                        %% asn1ct_gen:insert_once(inlined_objects,ObjKey),
 
1947
                        insert_once(S,inlined_objects,ObjKey),
 
1948
                        %% Which module to use here? Could it be other than top_module ?
 
1949
                        %% asn1_db:dbput(S#state.mname,InlinedObjName,InlObj),
 
1950
                        asn1_db:dbput(get(top_module),InlinedObjName,InlObj),
1723
1951
                        InlObj;
1724
1952
                    #type{def=Eref} when record(Eref,'Externaltypereference') ->
1725
1953
                        {_,O} = get_referenced_type(S,Eref),
1726
1954
                        CheckObject(O);
1727
 
                    _ ->
1728
 
                        {_,O} = get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=ObjFieldSetting}),
 
1955
                    Other ->
 
1956
                        {_,O} = get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=Other}),
1729
1957
                        CheckObject(O)
1730
1958
                end,
1731
1959
            {{ObjFieldName,ObjectSpec},RestSettings};
1736
1964
%%      objectset_or_fixedtypevalueset_field ->
1737
1965
%%          ok;
1738
1966
        objectsetfield ->
1739
 
            {_,ObjSetSpec} = 
1740
 
                case ObjFieldSetting of
1741
 
                    Ref when record(Ref,'Externaltypereference');
1742
 
                             record(Ref,'Externalvaluereference') ->
1743
 
                        get_referenced_type(S,ObjFieldSetting);
1744
 
                    ObjectList when list(ObjectList) ->
1745
 
                        %% an objctset defined in the object,though maybe
1746
 
                        %% parsed as a SequenceOfValue 
1747
 
                        %% The ObjectList may be a list of references to
1748
 
                        %% objects, a ValueFromObject
1749
 
                        ?dbg("objectsetfield: ~p~n",[CField]),
1750
 
                        {_,_,Type,_} = CField,
1751
 
                        ClassDef = Type#type.def,
1752
 
%                       end,
1753
 
                        ?dbg("objectsetfield: ~p~n",[Type]),
1754
 
                        {no_name,
1755
 
                         #typedef{typespec=
1756
 
                                  #'ObjectSet'{class=
1757
 
                                               ClassDef,
1758
 
                                               set=ObjectList}}};
1759
 
 
1760
 
                    {'SingleValue',_} ->
1761
 
                        %% a Union of defined objects
1762
 
                        ?dbg("objectsetfield, SingleValue~n",[]),
1763
 
                        union_of_defed_objs(CField,ObjFieldSetting);
1764
 
 
1765
 
                    {{'SingleValue',_},_} ->
1766
 
                        %% a Union of defined objects
1767
 
                        union_of_defed_objs(CField,ObjFieldSetting);
1768
 
 
1769
 
                    {object,_,[#type{def={'TypeFromObject',
1770
 
                                         {object,RefedObj},
1771
 
                                         FieldName}}]} ->
1772
 
                        %% This case occurs when an ObjectSetFromObjects 
1773
 
                        %% production is used
1774
 
                        {M,Def} = get_referenced_type(S,RefedObj),
1775
 
                        {M,get_fieldname_element(S,Def,FieldName)};
1776
 
                    #type{def=Eref} when 
1777
 
                          record(Eref,'Externaltypereference') ->
1778
 
                        get_referenced_type(S,Eref);
1779
 
                    _ ->
1780
 
                        get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=ObjFieldSetting})
1781
 
                end,
 
1967
            ObjSetSpec = get_objectset_def(S,ObjFieldSetting,CField),
1782
1968
            ?dbg("objectsetfield, ObjSetSpec:~p~n",[ObjSetSpec]),
1783
1969
            {{ObjFieldName,
1784
1970
              ObjSetSpec#typedef{checked=true,
1785
1971
                                 typespec=check_object(S,ObjSetSpec,
1786
 
                                                      ObjSetSpec#typedef.typespec)}},RestSettings}
 
1972
                                                       ObjSetSpec#typedef.typespec)}},RestSettings}
1787
1973
    end.
1788
1974
 
 
1975
get_objectset_def(S,Ref,CField)
 
1976
  when is_record(Ref,'Externaltypereference');
 
1977
       is_record(Ref,'Externalvaluereference') ->
 
1978
    {_M,T}=get_referenced_type(S,Ref),
 
1979
    get_objectset_def2(S,T,CField);
 
1980
get_objectset_def(S,ObjectList,CField) when is_list(ObjectList) ->
 
1981
    %% an objctset defined in the object,though maybe
 
1982
    %% parsed as a SequenceOfValue 
 
1983
    %% The ObjectList may be a list of references to
 
1984
    %% objects, a ValueFromObject
 
1985
    ?dbg("objectsetfield: ~p~n",[CField]),
 
1986
    get_objectset_def2(S,ObjectList,CField);
 
1987
get_objectset_def(S,'EXTENSIONMARK',CField) ->
 
1988
    ?dbg("objectsetfield: ~p~n",[CField]),
 
1989
    get_objectset_def2(S,['EXTENSIONMARK'],CField);
 
1990
get_objectset_def(_S,ObjFieldSetting={'SingleValue',_},CField) ->
 
1991
    %% a Union of defined objects
 
1992
    ?dbg("objectsetfield, SingleValue~n",[]),
 
1993
    union_of_defed_objs(CField,ObjFieldSetting);
 
1994
get_objectset_def(_S,ObjFieldSetting={{'SingleValue',_},_},CField) ->
 
1995
    %% a Union of defined objects
 
1996
    ?dbg("objectsetfield, SingleValue~n",[]),
 
1997
    union_of_defed_objs(CField,ObjFieldSetting);
 
1998
get_objectset_def(S,{object,_,[#type{def={'TypeFromObject',
 
1999
                                          {object,RefedObj},
 
2000
                                          FieldName}}]},_CField) ->
 
2001
    %% This case occurs when an ObjectSetFromObjects 
 
2002
    %% production is used
 
2003
    {_M,Def} = get_referenced_type(S,RefedObj),
 
2004
    get_fieldname_element(S,Def,FieldName);
 
2005
get_objectset_def(S,{object,_,[{setting,_,ERef}]},CField)
 
2006
  when is_record(ERef,'Externaltypereference') ->
 
2007
    {_,T} = get_referenced_type(S,ERef),
 
2008
    get_objectset_def2(S,T,CField);
 
2009
get_objectset_def(S,#type{def=ERef},_CField) 
 
2010
  when is_record(ERef,'Externaltypereference') ->
 
2011
    {_,T} = get_referenced_type(S,ERef),
 
2012
    T;
 
2013
get_objectset_def(S,ObjFieldSetting,CField)
 
2014
  when is_atom(ObjFieldSetting) ->
 
2015
    ERef = #'Externaltypereference'{module=S#state.mname,
 
2016
                                    type=ObjFieldSetting},
 
2017
    {_,T} = get_referenced_type(S,ERef),
 
2018
    get_objectset_def2(S,T,CField).
 
2019
 
 
2020
get_objectset_def2(_S,T = #typedef{typespec=#'Object'{}},_CField) ->
 
2021
    #typedef{typespec=#'Object'{classname=Class,def=Def}} = T,
 
2022
    T#typedef{typespec=#'ObjectSet'{class=Class,set=[Def]}};
 
2023
get_objectset_def2(_S,Set,CField) when is_list(Set) ->
 
2024
    {_,_,Type,_} = CField,
 
2025
    ClassDef = Type#type.def,
 
2026
    #typedef{typespec=#'ObjectSet'{class=ClassDef,
 
2027
                                   set=Set}};
 
2028
get_objectset_def2(_S,T = #typedef{typespec=#'ObjectSet'{}},_CField) ->
 
2029
    T;
 
2030
get_objectset_def2(_S,T,_CField) ->
 
2031
    io:format("Warning get_objectset_def2: uncontrolled object set structure:~n~p~n",[T]).
 
2032
    
1789
2033
type_name(S,#type{def=Def}) ->
1790
2034
    CurrMod = S#state.mname,
1791
2035
    case asn1ct_gen:type(asn1ct_gen:get_inner(Def)) of
1836
2080
        
1837
2081
        
1838
2082
union_of_defed_objs({_,_,_ObjClass=#type{def=ClassDef},_},ObjFieldSetting) -> 
1839
 
    {no_name,#typedef{typespec=#'ObjectSet'{class = ClassDef,
1840
 
                                            set = ObjFieldSetting}}};
 
2083
    #typedef{typespec=#'ObjectSet'{class = ClassDef,
 
2084
                                   set = ObjFieldSetting}};
1841
2085
union_of_defed_objs({_,_,DefObjClassRef,_},ObjFieldSetting)
1842
2086
  when is_record(DefObjClassRef,'Externaltypereference') ->
1843
 
    {no_name,#typedef{typespec=#'ObjectSet'{class = DefObjClassRef,
1844
 
                                            set = ObjFieldSetting}}}.
 
2087
    #typedef{typespec=#'ObjectSet'{class = DefObjClassRef,
 
2088
                                   set = ObjFieldSetting}}.
1845
2089
    
1846
2090
 
1847
2091
check_value(OldS,V) when record(V,pvaluesetdef) ->
1866
2110
    #typedef{typespec=TS} = V,
1867
2111
    case TS of 
1868
2112
        #'ObjectSet'{class=ClassRef} ->
1869
 
            {_,TSDef} = get_referenced_type(OldS,ClassRef),
 
2113
            {RefM,TSDef} = get_referenced_type(OldS,ClassRef),
1870
2114
            %%IsObjectSet(TSDef);
1871
2115
            case TSDef of
1872
2116
                #classdef{} -> throw({objectsetdef});
1880
2124
                    ValueSet = TS#'ObjectSet'.set,
1881
2125
                    Type=check_type(OldS,TSDef,TSDef#typedef.typespec),
1882
2126
                    Value = check_value(OldS,#valuedef{type=Type,
1883
 
                                                       value=ValueSet}),
 
2127
                                                       value=ValueSet,
 
2128
                                                       module=RefM}),
1884
2129
                    {valueset,Type#type{constraint=Value#valuedef.value}}
1885
2130
            end;
1886
2131
        _ ->
1892
2137
    {valueset,
1893
2138
     check_type(S,#typedef{pos=Pos,name=Name,typespec=NewType},NewType)};
1894
2139
check_value(OldS=#state{recordtopname=TopName},V) when record(V,valuedef) ->
1895
 
    #valuedef{name=Name,checked=Checked,type=Vtype,value=Value} = V,
 
2140
    #valuedef{name=Name,checked=Checked,type=Vtype,
 
2141
              value=Value,module=ModName} = V,
1896
2142
    ?dbg("check_value, V: ~p~n",[V]),
1897
2143
    case Checked of
1898
2144
        true -> 
1903
2149
            Def = Vtype#type.def,
1904
2150
            Constr = Vtype#type.constraint,
1905
2151
            S = OldS#state{type=Vtype,tname=Def,value=V,vname=Name},
 
2152
            SVal = update_state(S,ModName),
1906
2153
            NewDef = 
1907
2154
                case Def of
1908
2155
                    Ext when record(Ext,'Externaltypereference') ->
1925
2172
                                            check_value(NewS#state{recordtopname=[RecName|TopName]},
1926
2173
                                                        V#valuedef{type=Type#typedef.typespec}),
1927
2174
                                        #newv{value=CheckedVal}
1928
 
                                end
 
2175
                                end;
 
2176
                            #type{} ->
 
2177
                                %% A parameter that couldn't be categorized.
 
2178
                                #valuedef{value=CheckedVal}=
 
2179
                                    check_value(NewS#state{recordtopname=[RecName|TopName]},
 
2180
                                                V#valuedef{type=Type}),
 
2181
                                #newv{value=CheckedVal}
1929
2182
                        end;
1930
2183
                    'ANY' ->
1931
2184
                        case Value of
1932
2185
                            {opentypefieldvalue,ANYType,ANYValue} ->
1933
 
                                CheckedV=check_value(S,#valuedef{name=Name,type=ANYType,value=ANYValue}),
 
2186
                                CheckedV=
 
2187
                                    check_value(SVal,#valuedef{name=Name,
 
2188
                                                               type=ANYType,
 
2189
                                                               value=ANYValue,
 
2190
                                                               module=ModName}),
1934
2191
                                #newv{value=CheckedV#valuedef.value};
1935
2192
                            _ ->
1936
2193
                                throw({error,{asn1,{'cant check value of type',Def}}})
1937
2194
                        end;
1938
2195
                    'INTEGER' ->
1939
 
                        ok=validate_integer(S,Value,[],Constr),
1940
 
                        #newv{value=normalize_value(S,Vtype,Value,[])};
 
2196
                        ok=validate_integer(SVal,Value,[],Constr),
 
2197
                        #newv{value=normalize_value(SVal,Vtype,Value,[])};
1941
2198
                    {'INTEGER',NamedNumberList} ->
1942
 
                        ok=validate_integer(S,Value,NamedNumberList,Constr),
1943
 
                        #newv{value=normalize_value(S,Vtype,Value,[])};
 
2199
                        ok=validate_integer(SVal,Value,NamedNumberList,Constr),
 
2200
                        #newv{value=normalize_value(SVal,Vtype,Value,[])};
1944
2201
                    {'BIT STRING',NamedNumberList} ->
1945
 
                        ok=validate_bitstring(S,Value,NamedNumberList,Constr),
1946
 
                        #newv{value=normalize_value(S,Vtype,Value,[])};
 
2202
                        ok=validate_bitstring(SVal,Value,NamedNumberList,Constr),
 
2203
                        #newv{value=normalize_value(SVal,Vtype,Value,[])};
1947
2204
                    'NULL' ->
1948
 
                        ok=validate_null(S,Value,Constr),
 
2205
                        ok=validate_null(SVal,Value,Constr),
1949
2206
                        #newv{};
1950
2207
                    'OBJECT IDENTIFIER' ->
1951
 
                        {ok,_}=validate_objectidentifier(S,Value,Constr),
1952
 
                        #newv{value = normalize_value(S,Vtype,Value,[])};
 
2208
                        {ok,_}=validate_objectidentifier(SVal,Value,Constr),
 
2209
                        #newv{value = normalize_value(SVal,Vtype,Value,[])};
 
2210
                    'RELATIVE-OID' ->
 
2211
                        {ok,_}=validate_relative_oid(SVal,Value,Constr),
 
2212
                        #newv{value = Value};
1953
2213
                    'ObjectDescriptor' ->
1954
 
                        ok=validate_objectdescriptor(S,Value,Constr),
1955
 
                        #newv{value=normalize_value(S,Vtype,Value,[])};
 
2214
                        ok=validate_objectdescriptor(SVal,Value,Constr),
 
2215
                        #newv{value=normalize_value(SVal,Vtype,Value,[])};
 
2216
                    'REAL' ->
 
2217
                        ok = validate_real(SVal,Value,Constr),
 
2218
                        #newv{value=normalize_value(SVal,Vtype,Value,[])};
1956
2219
                    {'ENUMERATED',NamedNumberList} ->
1957
 
                        ok=validate_enumerated(S,Value,NamedNumberList,Constr),
1958
 
                        #newv{value=normalize_value(S,Vtype,Value,[])};
 
2220
                        ok=validate_enumerated(SVal,Value,NamedNumberList,Constr),
 
2221
                        #newv{value=normalize_value(SVal,Vtype,Value,[])};
1959
2222
                    'BOOLEAN'->
1960
 
                        ok=validate_boolean(S,Value,Constr),
1961
 
                        #newv{value=normalize_value(S,Vtype,Value,[])};
 
2223
                        ok=validate_boolean(SVal,Value,Constr),
 
2224
                        #newv{value=normalize_value(SVal,Vtype,Value,[])};
1962
2225
                    'OCTET STRING' ->
1963
 
                        ok=validate_octetstring(S,Value,Constr),
1964
 
                        #newv{value=normalize_value(S,Vtype,Value,[])};
 
2226
                        ok=validate_octetstring(SVal,Value,Constr),
 
2227
                        #newv{value=normalize_value(SVal,Vtype,Value,[])};
1965
2228
                    'NumericString' ->
1966
 
                        ok=validate_restrictedstring(S,Value,Def,Constr),
1967
 
                        #newv{value=normalize_value(S,Vtype,Value,[])};
 
2229
                        ok=validate_restrictedstring(SVal,Value,Def,Constr),
 
2230
                        #newv{value=normalize_value(SVal,Vtype,Value,[])};
1968
2231
                    TString when TString =:= 'TeletexString';
1969
2232
                                 TString =:= 'T61String' ->
1970
 
                        ok=validate_restrictedstring(S,Value,Def,Constr),
1971
 
                        #newv{value=normalize_value(S,Vtype,Value,[])};
 
2233
                        ok=validate_restrictedstring(SVal,Value,Def,Constr),
 
2234
                        #newv{value=normalize_value(SVal,Vtype,Value,[])};
1972
2235
                    'VideotexString' ->
1973
 
                        ok=validate_restrictedstring(S,Value,Def,Constr),
1974
 
                        #newv{value=normalize_value(S,Vtype,Value,[])};
 
2236
                        ok=validate_restrictedstring(SVal,Value,Def,Constr),
 
2237
                        #newv{value=normalize_value(SVal,Vtype,Value,[])};
1975
2238
                    'UTCTime' ->
1976
 
                        #newv{value=normalize_value(S,Vtype,Value,[])};
 
2239
                        #newv{value=normalize_value(SVal,Vtype,Value,[])};
1977
2240
%                       exit({'cant check value of type' ,Def});
1978
2241
                    'GeneralizedTime' ->
1979
 
                        #newv{value=normalize_value(S,Vtype,Value,[])};
 
2242
                        #newv{value=normalize_value(SVal,Vtype,Value,[])};
1980
2243
%                       exit({'cant check value of type' ,Def});
1981
2244
                    'GraphicString' ->
1982
 
                        ok=validate_restrictedstring(S,Value,Def,Constr),
1983
 
                        #newv{value=normalize_value(S,Vtype,Value,[])};
 
2245
                        ok=validate_restrictedstring(SVal,Value,Def,Constr),
 
2246
                        #newv{value=normalize_value(SVal,Vtype,Value,[])};
1984
2247
                    'VisibleString' ->
1985
 
                        ok=validate_restrictedstring(S,Value,Def,Constr),
1986
 
                        #newv{value=normalize_value(S,Vtype,Value,[])};
 
2248
                        ok=validate_restrictedstring(SVal,Value,Def,Constr),
 
2249
                        #newv{value=normalize_value(SVal,Vtype,Value,[])};
1987
2250
                    'GeneralString' ->
1988
 
                        ok=validate_restrictedstring(S,Value,Def,Constr),
1989
 
                        #newv{value=normalize_value(S,Vtype,Value,[])};
 
2251
                        ok=validate_restrictedstring(SVal,Value,Def,Constr),
 
2252
                        #newv{value=normalize_value(SVal,Vtype,Value,[])};
1990
2253
                    'PrintableString' ->
1991
 
                        ok=validate_restrictedstring(S,Value,Def,Constr),
1992
 
                        #newv{value=normalize_value(S,Vtype,Value,[])};
 
2254
                        ok=validate_restrictedstring(SVal,Value,Def,Constr),
 
2255
                        #newv{value=normalize_value(SVal,Vtype,Value,[])};
1993
2256
                    'IA5String' ->
1994
 
                        ok=validate_restrictedstring(S,Value,Def,Constr),
1995
 
                        #newv{value=normalize_value(S,Vtype,Value,[])};
 
2257
                        ok=validate_restrictedstring(SVal,Value,Def,Constr),
 
2258
                        #newv{value=normalize_value(SVal,Vtype,Value,[])};
1996
2259
                    'BMPString' ->
1997
 
                        ok=validate_restrictedstring(S,Value,Def,Constr),
1998
 
                        #newv{value=normalize_value(S,Vtype,Value,[])};
 
2260
                        ok=validate_restrictedstring(SVal,Value,Def,Constr),
 
2261
                        #newv{value=normalize_value(SVal,Vtype,Value,[])};
1999
2262
                    'UTF8String' ->
2000
 
                        ok = validate_restrictedstring(S,Vtype,Value,Constr),
 
2263
                        ok = validate_restrictedstring(SVal,Vtype,Value,Constr),
2001
2264
                        %%io:format("Vtype: ~p~nValue: ~p~n",[Vtype,Value]);
2002
 
                        #newv{value=normalize_value(S,Vtype,Value,[])};
 
2265
                        #newv{value=normalize_value(SVal,Vtype,Value,[])};
2003
2266
                    'UniversalString' -> %added 6/12 -00
2004
 
                        ok = validate_restrictedstring(S,Value,Def,Constr),
2005
 
                        #newv{value=normalize_value(S,Vtype,Value,[])};
 
2267
                        ok = validate_restrictedstring(SVal,Value,Def,Constr),
 
2268
                        #newv{value=normalize_value(SVal,Vtype,Value,[])};
2006
2269
                    Seq when record(Seq,'SEQUENCE') ->
2007
 
                        {ok,SeqVal} = validate_sequence(S,Value,
 
2270
                        {ok,SeqVal} = validate_sequence(SVal,Value,
2008
2271
                                                   Seq#'SEQUENCE'.components,
2009
2272
                                                   Constr),
2010
 
                        #newv{value=normalize_value(S,Vtype,SeqVal,TopName)};
 
2273
                        #newv{value=normalize_value(SVal,Vtype,SeqVal,TopName)};
2011
2274
                    {'SEQUENCE OF',Components} ->
2012
 
                        ok=validate_sequenceof(S,Value,Components,Constr),
2013
 
                        #newv{value=normalize_value(S,Vtype,Value,TopName)};
 
2275
                        ok=validate_sequenceof(SVal,Value,Components,Constr),
 
2276
                        #newv{value=normalize_value(SVal,Vtype,Value,TopName)};
2014
2277
                    {'CHOICE',Components} ->
2015
 
                        ok=validate_choice(S,Value,Components,Constr),
2016
 
                        #newv{value=normalize_value(S,Vtype,Value,TopName)};
 
2278
                        ok=validate_choice(SVal,Value,Components,Constr),
 
2279
                        #newv{value=normalize_value(SVal,Vtype,Value,TopName)};
2017
2280
                    Set when record(Set,'SET') ->
2018
 
                        ok=validate_set(S,Value,Set#'SET'.components,
 
2281
                        ok=validate_set(SVal,Value,Set#'SET'.components,
2019
2282
                                              Constr),
2020
 
                        #newv{value=normalize_value(S,Vtype,Value,TopName)};
 
2283
                        #newv{value=normalize_value(SVal,Vtype,Value,TopName)};
2021
2284
                    {'SET OF',Components} ->
2022
 
                        ok=validate_setof(S,Value,Components,Constr),
2023
 
                        #newv{value=normalize_value(S,Vtype,Value,TopName)};
 
2285
                        ok=validate_setof(SVal,Value,Components,Constr),
 
2286
                        #newv{value=normalize_value(SVal,Vtype,Value,TopName)};
2024
2287
                    {'SelectionType',SelName,SelT} ->
2025
 
                        CheckedT = check_selectiontype(S,SelName,SelT),
 
2288
                        CheckedT = check_selectiontype(SVal,SelName,SelT),
2026
2289
                        NewV = V#valuedef{type=CheckedT},
2027
2290
                        SelVDef=check_value(S#state{value=NewV},NewV),
2028
2291
                        #newv{value=SelVDef#valuedef.value};
2056
2319
%       false -> error({value,"unknown NamedNumber",S})
2057
2320
%     end;
2058
2321
%% This case occurs when there is a valuereference
2059
 
validate_integer(S=#state{mname=M},
2060
 
                 #'Externalvaluereference'{module=M,value=Id}=Ref,
 
2322
%% validate_integer(S=#state{mname=M},
 
2323
%%               #'Externalvaluereference'{module=M,value=Id}=Ref,
 
2324
validate_integer(S,#'Externalvaluereference'{value=Id}=Ref,
2061
2325
                 NamedNumberList,Constr) ->
2062
2326
    case lists:keysearch(Id,1,NamedNumberList) of
2063
2327
        {value,_} -> ok;
2122
2386
is_space_list([H|T],Acc) ->
2123
2387
    is_space_list(T,[H|Acc]).
2124
2388
 
2125
 
validate_objectidentifier(S,ERef,C) 
 
2389
validate_objectidentifier(S,ERef,C) ->
 
2390
    validate_objectidentifier(S,o_id,ERef,C).
 
2391
 
 
2392
validate_objectidentifier(S,OID,ERef,C) 
2126
2393
  when record(ERef,'Externalvaluereference') ->
2127
 
    validate_objectidentifier(S,[ERef],C);
2128
 
validate_objectidentifier(S,L,_) ->
 
2394
    validate_objectidentifier(S,OID,[ERef],C);
 
2395
validate_objectidentifier(S,OID,Tup,C) when is_tuple(Tup) ->
 
2396
    validate_objectidentifier(S,OID,tuple_to_list(Tup),C);
 
2397
validate_objectidentifier(S,OID,L,_) ->
2129
2398
    NewL = is_space_list(L,[]),
2130
 
    case validate_objectidentifier1(S,NewL) of
 
2399
    case validate_objectidentifier1(S,OID,NewL) of
2131
2400
        NewL2 when is_list(NewL2) ->{ok,list_to_tuple(NewL2)};
2132
2401
        Other -> {ok,Other}
2133
2402
    end.
2134
2403
 
2135
 
validate_objectidentifier1(S, [Id|T]) when record(Id,'Externalvaluereference') ->
 
2404
validate_objectidentifier1(S, OID, [Id|T])
 
2405
  when record(Id,'Externalvaluereference') ->
2136
2406
    case catch get_referenced_type(S,Id) of
2137
2407
        {M,V} when record(V,valuedef) -> 
2138
 
            %%NewS = S#state{mname=M},
2139
2408
            NewS = update_state(S,M),
2140
2409
            case check_value(NewS,V) of
2141
 
%               #valuedef{type=#type{def='OBJECT IDENTIFIER'},
2142
 
%                         checked=true,value=Value} when tuple(Value) ->
2143
 
%                   validate_objectid(S, T, lists:reverse(tuple_to_list(Value)));
2144
2410
                #valuedef{type=#type{def=ERef},checked=true,
2145
 
                          value=Value} when tuple(Value) ->
2146
 
                    case is_object_id(NewS,ERef) of
 
2411
                          value=Value} when is_tuple(Value) ->
 
2412
                    case is_object_id(OID,NewS,ERef) of 
2147
2413
                        true ->
2148
 
                            validate_objectid(NewS, T, lists:reverse(tuple_to_list(Value)));
 
2414
                            %% T must be a RELATIVE-OID
 
2415
                            validate_oid(true,NewS, rel_oid, T, lists:reverse(tuple_to_list(Value)));
2149
2416
                        _ ->
2150
 
                            error({value, "illegal OBJECT IDENTIFIER", S})
 
2417
                            error({value, {"illegal "++to_string(OID),[Id|T]}, S})
2151
2418
                    end;
2152
2419
                _ -> 
2153
 
                    error({value, "illegal OBJECT IDENTIFIER", S})
 
2420
                    error({value, {"illegal "++to_string(OID),[Id|T]}, S})
2154
2421
            end;
2155
2422
        _ ->
2156
 
            validate_objectid(S, [Id|T], [])
 
2423
            validate_oid(true,S, OID, [Id|T], [])
2157
2424
    end;
2158
 
validate_objectidentifier1(S,V) ->
2159
 
    validate_objectid(S,V,[]).
 
2425
validate_objectidentifier1(S,OID,V) ->
 
2426
    validate_oid(true,S,OID,V,[]).
2160
2427
 
2161
 
validate_objectid(_, [], Acc) ->
 
2428
validate_oid(false, S, OID, V, Acc) ->
 
2429
    error({value, {"illegal "++to_string(OID), V,Acc}, S});
 
2430
validate_oid(_,_, _, [], Acc) ->
2162
2431
    lists:reverse(Acc);
2163
 
validate_objectid(S, [Value|Vrest], Acc) when integer(Value) ->
2164
 
    validate_objectid(S, Vrest, [Value|Acc]);
2165
 
validate_objectid(S, [{'NamedNumber',_Name,Value}|Vrest], Acc) 
2166
 
  when integer(Value) ->
2167
 
    validate_objectid(S, Vrest, [Value|Acc]);
2168
 
validate_objectid(S, [Id|Vrest], Acc) 
 
2432
validate_oid(_, S, OID, [Value|Vrest], Acc) when is_integer(Value) ->
 
2433
    validate_oid(valid_objectid(OID,Value,Acc),S, OID, Vrest, [Value|Acc]);
 
2434
validate_oid(_, S, OID, [{'NamedNumber',_Name,Value}|Vrest], Acc) 
 
2435
  when is_integer(Value) ->
 
2436
    validate_oid(valid_objectid(OID,Value,Acc), S, OID, Vrest, [Value|Acc]);
 
2437
validate_oid(_, S, OID, [Id|Vrest], Acc) 
2169
2438
  when record(Id,'Externalvaluereference') ->
2170
2439
    case catch get_referenced_type(S, Id) of
2171
 
        {M,V} when record(V,valuedef) ->
2172
 
            %%NewS = S#state{mname=M},
 
2440
        {M,V} when is_record(V,valuedef) ->
2173
2441
            NewS = update_state(S,M),
2174
 
            case check_value(NewS, V) of
2175
 
                #valuedef{checked=true,value=Value} when integer(Value) ->
2176
 
                    validate_objectid(NewS, Vrest, [Value|Acc]);
2177
 
                _ -> 
2178
 
                    error({value, "illegal OBJECT IDENTIFIER", S})
 
2442
            NewVal = case check_value(NewS, V) of
 
2443
                         #valuedef{checked=true,value=Value} ->
 
2444
                             fun(Int) when is_integer(Int) ->  [Int];
 
2445
                                (L) when is_list(L) -> L;
 
2446
                                (T) when is_tuple(T) -> tuple_to_list(T)
 
2447
                             end (Value);
 
2448
                         _ ->
 
2449
                             error({value, {"illegal "++to_string(OID),
 
2450
                                            [Id|Vrest],Acc}, S})
 
2451
                     end,
 
2452
            case NewVal of
 
2453
                List when is_list(List) ->
 
2454
                    validate_oid(valid_objectid(OID,NewVal,Acc), NewS, 
 
2455
                                 OID, Vrest,lists:reverse(NewVal)++Acc);
 
2456
                _ ->
 
2457
                    NewVal
2179
2458
            end;
2180
2459
        _ ->
2181
2460
            case reserved_objectid(Id#'Externalvaluereference'.value, Acc) of
2182
 
                Value when integer(Value) ->
2183
 
                    validate_objectid(S, Vrest, [Value|Acc]);
 
2461
                Value when is_integer(Value) ->
 
2462
                    validate_oid(valid_objectid(OID,Value,Acc),
 
2463
                                 S, OID,Vrest, [Value|Acc]);
2184
2464
                false ->
2185
 
                    error({value, "illegal OBJECT IDENTIFIER", S})
 
2465
                    error({value, {"illegal "++to_string(OID),[Id,Vrest],Acc}, S})
2186
2466
            end
2187
2467
    end;
2188
 
validate_objectid(S, [{Atom,Value}],[]) when atom(Atom),integer(Value) ->
 
2468
validate_oid(_, S, OID, [{Atom,Value}],[]) 
 
2469
  when is_atom(Atom),is_integer(Value) ->
2189
2470
    %% this case when an OBJECT IDENTIFIER value has been parsed as a 
2190
2471
    %% SEQUENCE value
2191
2472
    Rec = #'Externalvaluereference'{module=S#state.mname,
2192
2473
                                    value=Atom},
2193
 
    validate_objectidentifier1(S,[Rec,Value]);
2194
 
validate_objectid(S, [{Atom,EVRef}],[]) 
2195
 
  when atom(Atom),record(EVRef,'Externalvaluereference') ->
 
2474
    validate_objectidentifier1(S, OID, [Rec,Value]);
 
2475
validate_oid(_, S, OID, [{Atom,EVRef}],[]) 
 
2476
  when is_atom(Atom),is_record(EVRef,'Externalvaluereference') ->
2196
2477
    %% this case when an OBJECT IDENTIFIER value has been parsed as a 
2197
2478
    %% SEQUENCE value OTP-4354
 
2479
    Rec = #'Externalvaluereference'{module=EVRef#'Externalvaluereference'.module,
 
2480
                                    value=Atom},
 
2481
    validate_objectidentifier1(S, OID, [Rec,EVRef]);
 
2482
validate_oid(_, S, OID, [Atom|Rest],Acc) when is_atom(Atom) ->
2198
2483
    Rec = #'Externalvaluereference'{module=S#state.mname,
2199
2484
                                    value=Atom},
2200
 
    validate_objectidentifier1(S,[Rec,EVRef]);
2201
 
validate_objectid(S, _V, _Acc) ->
2202
 
    error({value, "illegal OBJECT IDENTIFIER",S}).
2203
 
 
2204
 
is_object_id(S,ERef=#'Externaltypereference'{}) ->
 
2485
    validate_oid(true,S, OID, [Rec|Rest],Acc);
 
2486
validate_oid(_, S, OID, V, Acc) ->
 
2487
    error({value, {"illegal "++to_string(OID),V,Acc},S}).
 
2488
 
 
2489
validate_relative_oid(S,Value,Constr) ->
 
2490
    validate_objectidentifier(S,rel_oid,Value,Constr).
 
2491
 
 
2492
is_object_id(OID,S,ERef=#'Externaltypereference'{}) ->
2205
2493
    {_,OI} = get_referenced_type(S,ERef),
2206
 
    is_object_id(S,OI#typedef.typespec);
2207
 
is_object_id(_S,'OBJECT IDENTIFIER') ->
2208
 
    true;
2209
 
is_object_id(S,#type{def=Def}) ->
2210
 
    is_object_id(S,Def);
2211
 
is_object_id(_S,_) ->
 
2494
    is_object_id(OID,S,OI#typedef.typespec);
 
2495
is_object_id(o_id,_S,'OBJECT IDENTIFIER') ->
 
2496
    true;
 
2497
is_object_id(rel_oid,_S,'RELATIVE-OID') ->
 
2498
    true;
 
2499
is_object_id(_,_S,'INTEGER') ->
 
2500
    true;
 
2501
is_object_id(OID,S,#type{def=Def}) ->
 
2502
    is_object_id(OID,S,Def);
 
2503
is_object_id(_,_S,_) ->
2212
2504
    false.
2213
2505
 
 
2506
to_string(o_id) ->
 
2507
    "OBJECT IDENTIFIER";
 
2508
to_string(rel_oid) ->
 
2509
    "RELATIVE-OID".
 
2510
 
2214
2511
%% ITU-T Rec. X.680 Annex B - D
2215
2512
reserved_objectid('itu-t',[]) -> 0;
2216
2513
reserved_objectid('ccitt',[]) -> 0;
2260
2557
 
2261
2558
reserved_objectid(_,_) -> false.
2262
2559
 
 
2560
valid_objectid(_OID,[],_Acc) ->
 
2561
    true;
 
2562
valid_objectid(OID,[H|T],Acc) ->
 
2563
    case valid_objectid(OID, H, Acc) of
 
2564
        true ->
 
2565
            valid_objectid(OID,T,[H|Acc]);
 
2566
        _ ->
 
2567
            false
 
2568
    end;
 
2569
valid_objectid(o_id,I,[]) when I =:= 0; I =:= 1; I =:= 2 -> true;
 
2570
valid_objectid(o_id,_I,[]) -> false;
 
2571
valid_objectid(o_id,I,[0]) when I >= 0; I =< 4 -> true;
 
2572
valid_objectid(o_id,_I,[0]) -> false;
 
2573
valid_objectid(o_id,I,[1]) when I =:= 0; I =:= 2; I =:= 3 -> true;
 
2574
valid_objectid(o_id,_I,[1]) -> false;
 
2575
valid_objectid(o_id,_I,[2]) -> true;
 
2576
valid_objectid(_,_,_) -> true.
 
2577
 
 
2578
 
2263
2579
 
2264
2580
                 
2265
2581
            
2267
2583
validate_objectdescriptor(_S,_Value,_Constr) ->
2268
2584
    ok.
2269
2585
 
 
2586
validate_real(_S,_Value,_Constr) ->
 
2587
    ok.
 
2588
 
2270
2589
validate_enumerated(S,Id,NamedNumberList,_Constr) when atom(Id) ->
2271
2590
    case lists:keysearch(Id,1,NamedNumberList) of
2272
2591
        {value,_} -> ok;
2357
2676
        {'NULL',_CType,_} ->
2358
2677
            %%normalize_null(Value);
2359
2678
            'NULL';
 
2679
        {'RELATIVE-OID',_,_} ->
 
2680
            normalize_relative_oid(S,Value);
2360
2681
        {'OBJECT IDENTIFIER',_,_} ->
2361
2682
            normalize_objectidentifier(S,Value);
2362
2683
        {'ObjectDescriptor',_,_} ->
2377
2698
            normalize_setof(S,Value,CType,NewNameList);
2378
2699
        {restrictedstring,CType,_} ->
2379
2700
            normalize_restrictedstring(S,Value,CType);
2380
 
        {'ASN1_OPEN_TYPE',{typefield,_},NL} -> %an open type
 
2701
        {'ASN1_OPEN_TYPE',{typefield,_TF},NL} -> %an open type
2381
2702
            normalize_objectclassfieldvalue(S,Value,NL);
2382
2703
        Err ->
2383
2704
            io:format("WARNING: could not check default value ~p~nType:~n~p~nNameList:~n~p~n",[Value,Type,Err]),
2439
2760
    %% C - #'Externalvaluereference'{value=V}, where V is a defined value
2440
2761
    %% D - list of #'Externalvaluereference', where each value component
2441
2762
    %%     is an identifier corresponing to NamedBits in Type.
 
2763
    %% E - list of ones and zeros, if Value already is normalized.
2442
2764
    case Value of
2443
2765
        {hstring,String} when list(String) ->
2444
2766
            hstring_to_int(String);
2457
2779
                                    Other ->
2458
2780
                                        throw({error,Other})
2459
2781
                                end;
 
2782
                           (I) when I =:= 1; I =:= 0 ->
 
2783
                                I;
2460
2784
                           (Other) ->
2461
2785
                                throw({error,Other})
2462
2786
                        end,
2559
2883
    {ok,Val}=validate_objectidentifier(S,Value,[]),
2560
2884
    Val.
2561
2885
 
 
2886
normalize_relative_oid(S,Value) ->
 
2887
    {ok,Val} = validate_relative_oid(S,Value,[]),
 
2888
    Val.
 
2889
 
2562
2890
normalize_objectdescriptor(Value) ->
2563
2891
    Value.
2564
2892
 
2584
2912
            io:format("WARNING: Enumerated value is not correct ~p~n",[V]),
2585
2913
            V
2586
2914
    end.
2587
 
                      
 
2915
 
 
2916
 
2588
2917
normalize_choice(S,{'CHOICE',{C,V}},CType,NameList) when atom(C) ->
2589
 
    Value =
2590
 
        case V of
2591
 
            Rec when record(Rec,'Externalvaluereference') ->
2592
 
                get_normalized_value(S,V,CType,
2593
 
                                     fun normalize_choice/4,
2594
 
                                     [NameList]);
2595
 
            _ -> V
2596
 
        end,
2597
2918
    case catch lists:keysearch(C,#'ComponentType'.name,CType) of
2598
2919
        {value,#'ComponentType'{typespec=CT,name=Name}} ->
2599
 
            {C,normalize_value(S,CT,{'DEFAULT',Value},
 
2920
            {C,normalize_value(S,CT,{'DEFAULT',V},
2600
2921
                               [Name|NameList])};
2601
2922
        Other ->
2602
2923
            io:format("WARNING: Wrong format of type/value ~p/~p~n",
2603
 
                      [Other,Value]),
2604
 
            {C,Value}
 
2924
                      [Other,V]),
 
2925
            {C,V}
2605
2926
    end;
2606
2927
normalize_choice(S,{'DEFAULT',ValueList},CType,NameList) when is_list(ValueList) ->
2607
2928
    lists:map(fun(X)-> normalize_choice(S,X,CType,NameList) end, ValueList);
2608
2929
normalize_choice(S,Val=#'Externalvaluereference'{},CType,NameList) ->
2609
 
    {_,#valuedef{value=V}}=get_referenced_type(S,Val),
2610
 
    normalize_choice(S,{'CHOICE',V},CType,NameList);
 
2930
    {M,#valuedef{value=V}}=get_referenced_type(S,Val),
 
2931
    normalize_choice(update_state(S,M),{'CHOICE',V},CType,NameList);
2611
2932
%    get_normalized_value(S,Val,CType,fun normalize_choice/4,[NameList]);
2612
2933
normalize_choice(S,CV={Name,_ChoiceVal},CType,NameList) 
2613
2934
  when atom(Name) ->
2614
2935
%    normalize_choice(S,ChoiceVal,CType,NameList).
2615
 
    normalize_choice(S,{'CHOICE',CV},CType,NameList).
2616
 
            
 
2936
    normalize_choice(S,{'CHOICE',CV},CType,NameList);
 
2937
normalize_choice(_S,V,_CType,_NameList) ->
 
2938
    exit({error,{bad_choice_value,V}}).
 
2939
 
 
2940
%% normalize_choice(NameList,S,CVal = {'CHOICE',{_,_}},CType,_) ->
 
2941
%%     normalize_choice(S,CVal,CType,NameList);
 
2942
%% normalize_choice(NameList,S,CVal={'DEFAULT',VL},CType,_) when is_list(VL)->
 
2943
%%     normalize_choice(S,CVal,CType,NameList);
 
2944
%% normalize_choice(NameList,S,CV={Name,_CV},CType,_) when is_atom(Name)->
 
2945
%%     normalize_choice(S,{'CHOICE',CV},CType,NameList);
 
2946
%% normalize_choice(_,_S,V,_,_) ->
 
2947
%%     V.
 
2948
 
 
2949
normalize_sequence(S,Value,Components,NameList) 
 
2950
  when is_tuple(Components) ->
 
2951
    normalize_sequence(S,Value,lists:flatten(tuple_to_list(Components)),
 
2952
                       NameList); 
2617
2953
normalize_sequence(S,{Name,Value},Components,NameList) 
2618
2954
  when atom(Name),list(Value) ->
2619
2955
    normalize_sequence(S,Value,Components,NameList);
2620
2956
normalize_sequence(S,Value,Components,NameList) ->
2621
2957
    normalized_record('SEQUENCE',S,Value,Components,NameList).
2622
2958
 
 
2959
normalize_set(S,Value,Components,NameList) when is_tuple(Components) ->
 
2960
    normalize_set(S,Value,lists:flatten(tuple_to_list(Components)),NameList);
2623
2961
normalize_set(S,{Name,Value},Components,NameList) 
2624
2962
  when atom(Name),list(Value) ->
2625
2963
    normalized_record('SET',S,Value,Components,NameList);
2626
2964
normalize_set(S,Value,Components,NameList) ->
2627
2965
    NewName = list_to_atom(asn1ct_gen:list2name(NameList)),
2628
 
    case is_record_normalized(NewName,Value,length(Components)) of
 
2966
    case is_record_normalized(S,NewName,Value,length(Components)) of
2629
2967
        true ->
2630
2968
            Value;
2631
2969
        _ ->
2656
2994
normalized_record(SorS,S,Value,Components,NameList) ->
2657
2995
    NewName = list_to_atom(lists:concat([get_record_prefix_name(S),
2658
2996
                                         asn1ct_gen:list2name(NameList)])),
2659
 
    case is_record_normalized(NewName,Value,length(Components)) of
 
2997
    case is_record_normalized(S,NewName,Value,length(Components)) of
2660
2998
        true ->
2661
2999
            Value;
2662
3000
        _ ->
2668
3006
                    error({type,{illegal,default,value,Value},S})
2669
3007
            end
2670
3008
    end.
2671
 
is_record_normalized(Name,Value,NumComps) when is_tuple(Value) ->
 
3009
is_record_normalized(S,Name,V = #'Externalvaluereference'{},NumComps) ->
 
3010
    case get_referenced_type(S,V) of
 
3011
        {_M,#valuedef{type=_T1,value=V2}} ->
 
3012
            is_record_normalized(S,Name,V2,NumComps);
 
3013
        _ -> false
 
3014
    end;
 
3015
is_record_normalized(_S,Name,Value,NumComps) when is_tuple(Value) ->
2672
3016
    (size(Value) =:= (NumComps + 1)) andalso (element(1,Value)=:=Name);
2673
 
is_record_normalized(_,_,_) ->
 
3017
is_record_normalized(_,_,_,_) ->
2674
3018
    false.
2675
3019
 
2676
3020
normalize_seq_or_set(SorS,S,[{Cname,V}|Vs],
2761
3105
  when record(Value,'Externalvaluereference') ->
2762
3106
    get_normalized_value(S,Value,Type,fun normalize_s_of/5,
2763
3107
                         [SorS,NameList]).
2764
 
%     case catch get_referenced_type(S,Value) of
2765
 
%       {_,#valuedef{value=V}} ->
2766
 
%           normalize_s_of(SorS,S,V,Type);
2767
 
%       {error,Reason} ->
2768
 
%           io:format("WARNING: ~p could not handle value ~p~n",
2769
 
%                     [SorS,Value]),
2770
 
%           Value;
2771
 
%       {_,NewVal} ->
2772
 
%           normalize_s_of(SorS,S,NewVal,Type);
2773
 
%       _ ->
2774
 
%           io:format("WARNING: ~p could not handle value ~p~n",
2775
 
%                     [SorS,Value]),
2776
 
%           Value
2777
 
%     end.
2778
3108
 
2779
3109
 
2780
3110
%% normalize_restrictedstring handles all format of restricted strings.
2802
3132
    normalize_restrictedstring(S,Val,CType).
2803
3133
 
2804
3134
normalize_objectclassfieldvalue(S,{opentypefieldvalue,Type,Value},NameList) ->
2805
 
    normalize_value(S,Type,Value,NameList).
 
3135
    %% An open type has per definition no type. Thus should the type
 
3136
    %% information of the default type be available at
 
3137
    %% encode/decode. But as encoding the default value causes special
 
3138
    %% treatment (no encoding) whatever type is used the type
 
3139
    %% information is not necessary in encode/decode.
 
3140
    normalize_value(S,Type,Value,NameList);
 
3141
normalize_objectclassfieldvalue(_S,Other,_NameList) ->
 
3142
    %% If the type info was thrown away in an earlier step the value
 
3143
    %% is already normalized.
 
3144
     Other.
2806
3145
 
2807
3146
get_normalized_value(S,Val,Type,Func,AddArg) ->
2808
3147
    case catch get_referenced_type(S,Val) of
2809
 
        {_,#valuedef{type=_T,value=V}} -> 
 
3148
        {ExtM,_VDef = #valuedef{type=_T1,value=V}} -> 
2810
3149
            %% should check that Type and T equals
2811
 
            V2 = sort_val_if_set(AddArg,V,Type),
2812
 
            call_Func(S,V2,Type,Func,AddArg);
 
3150
            V2 = sort_val_if_set(AddArg,V,Type),
 
3151
            call_Func(update_state(S,ExtM),V2,Type,Func,AddArg);
2813
3152
        {error,_} ->
2814
3153
            io:format("WARNING: default value not "
2815
3154
                      "comparable ~p~n",[Val]),
2816
3155
            Val;
2817
 
        {_,NewVal} ->
 
3156
        {ExtM,NewVal} ->
2818
3157
            V2 = sort_val_if_set(AddArg,NewVal,Type),
2819
 
            call_Func(S,V2,Type,Func,AddArg);
 
3158
            call_Func(update_state(S,ExtM),V2,Type,Func,AddArg);
2820
3159
        _ ->
2821
3160
            io:format("WARNING: default value not "
2822
3161
                      "comparable ~p~n",[Val]),
2896
3235
                           (Type#typedef.checked==idle) -> % the check is going on
2897
3236
    Ts;
2898
3237
check_type(S=#state{recordtopname=TopName},Type,Ts) when record(Ts,type) ->
2899
 
    {Def,Tag,Constr} = 
 
3238
    {Def,Tag,Constr,IsInlined} = 
2900
3239
        case match_parameters(S,Ts#type.def,S#state.parameters) of
2901
 
            #type{tag=PTag,constraint=_Ctmp,def=Dtmp} ->
2902
 
                {Dtmp,merge_tags(Ts#type.tag,PTag),Ts#type.constraint};
 
3240
            #type{tag=PTag,constraint=_Ctmp,def=Dtmp,inlined=Inl} ->
 
3241
                {Dtmp,merge_tags(Ts#type.tag,PTag),Ts#type.constraint,Inl};
 
3242
            #typedef{typespec=#type{tag=PTag,def=Dtmp,inlined=Inl}} ->
 
3243
                {Dtmp,merge_tags(Ts#type.tag,PTag),Ts#type.constraint,Inl};
2903
3244
            Dtmp ->
2904
 
                {Dtmp,Ts#type.tag,Ts#type.constraint}
 
3245
                {Dtmp,Ts#type.tag,Ts#type.constraint,Ts#type.inlined}
2905
3246
        end,
2906
 
    TempNewDef = #newt{type=Def,tag=Tag,constraint=Constr},
 
3247
    TempNewDef = #newt{type=Def,tag=Tag,constraint=Constr,
 
3248
                       inlined=IsInlined},
2907
3249
    TestFun = 
2908
3250
        fun(Tref) ->
2909
3251
                {_,MaybeChoice} = get_referenced_type(S,Tref),
2923
3265
    NewDef= 
2924
3266
        case Def of 
2925
3267
            Ext when record(Ext,'Externaltypereference') ->
2926
 
                {RefMod,RefTypeDef} = get_referenced_type(S,Ext),
 
3268
                {RefMod,RefTypeDef,IsParamDef} = 
 
3269
                    case get_referenced_type(S,Ext) of
 
3270
                        {undefined,TmpTDef} -> %% A parameter
 
3271
                            {get(top_module),TmpTDef,true};
 
3272
                        {TmpRefMod,TmpRefDef} ->
 
3273
                            {TmpRefMod,TmpRefDef,false}
 
3274
                    end,
2927
3275
                case is_class(S,RefTypeDef) of
2928
3276
                    true -> throw({asn1_class,RefTypeDef});
2929
3277
                    _ -> ok
2930
3278
                end,
2931
3279
                Ct = TestFun(Ext),
2932
 
                RefType = 
 
3280
                {RefType,ExtRef} = 
2933
3281
                    case RefTypeDef#typedef.checked of
2934
3282
                        true ->
2935
 
                            RefTypeDef#typedef.typespec;
 
3283
                            {RefTypeDef#typedef.typespec,Ext};
2936
3284
                        _ ->  
 
3285
                            %% Put as idle to prevent recursive loops
2937
3286
                            NewRefTypeDef1 = RefTypeDef#typedef{checked=idle},
2938
3287
                            asn1_db:dbput(RefMod,
2939
3288
                                          get_datastr_name(NewRefTypeDef1),
2945
3294
                                           abscomppath=[],recordtopname=[]},
2946
3295
                            RefType1 = 
2947
3296
                                check_type(NewS,RefTypeDef,RefTypeDef#typedef.typespec),
 
3297
                            %% update the type and mark as checked
2948
3298
                            NewRefTypeDef2 = 
2949
3299
                                RefTypeDef#typedef{checked=true,typespec = RefType1},
 
3300
                            TmpName = get_datastr_name(NewRefTypeDef2),
2950
3301
                            asn1_db:dbput(RefMod,
2951
 
                                          get_datastr_name(NewRefTypeDef2),
2952
 
                                          NewRefTypeDef2), 
2953
 
                            %% update the type and mark as checked
2954
 
                            RefType1
 
3302
                                          TmpName,
 
3303
                                          NewRefTypeDef2),
 
3304
                            case {RefMod == get(top_module),IsParamDef} of
 
3305
                                {true,true} ->
 
3306
                                    Key = {TmpName,
 
3307
                                           type,
 
3308
                                           NewRefTypeDef2},
 
3309
                                    asn1ct_gen:insert_once(parameterized_objects,
 
3310
                                                           Key);
 
3311
                                _ -> ok
 
3312
                            end,
 
3313
                            {RefType1,#'Externaltypereference'{module=RefMod,
 
3314
                                                               type=TmpName}}
2955
3315
                    end,
2956
 
%                             _ -> RefTypeDef#typedef.typespec
2957
 
%                         end,NewAbsCPath
2958
3316
 
2959
3317
                case asn1ct_gen:prim_bif(asn1ct_gen:get_inner(RefType#type.def)) of
2960
3318
                    true ->
2961
3319
                        %% Here we expand to a built in type and inline it
2962
3320
                        NewS2 = S#state{type=#typedef{typespec=RefType}},
 
3321
                        NewC = 
 
3322
                            constraint_merge(NewS2,
 
3323
                                             check_constraints(NewS2,Constr)++
 
3324
                                             RefType#type.constraint),
2963
3325
                        TempNewDef#newt{
2964
 
                          type=
2965
 
                          RefType#type.def, 
2966
 
                          tag=
2967
 
                          merge_tags(Ct,RefType#type.tag),
2968
 
                          constraint=
2969
 
                          merge_constraints(check_constraints(NewS2,Constr),
2970
 
                                            RefType#type.constraint)};
 
3326
                          type = RefType#type.def, 
 
3327
                          tag = merge_tags(Ct,RefType#type.tag),
 
3328
                          constraint = NewC};
2971
3329
                    _ ->
2972
 
                        %% Here we only expand the tags and keep the ext ref
2973
 
                        NewExt = Ext#'Externaltypereference'{module=merged_mod(S,RefMod,Ext)},
 
3330
                        %% Here we only expand the tags and keep the ext ref.
 
3331
                            
 
3332
                        NewExt = ExtRef#'Externaltypereference'{module=merged_mod(S,RefMod,Ext)},
2974
3333
                        TempNewDef#newt{
2975
 
                          type=
2976
 
                          check_externaltypereference(S,NewExt),
2977
 
                          tag = 
2978
 
                          case S#state.erule of
2979
 
                              ber_bin_v2 ->
2980
 
                                  merge_tags(Ct,RefType#type.tag);
2981
 
                              _ ->
2982
 
                                  Ct
2983
 
                          end
 
3334
                          type = check_externaltypereference(S,NewExt),
 
3335
                          tag = case S#state.erule of
 
3336
                                    ber_bin_v2 ->
 
3337
                                        merge_tags(Ct,RefType#type.tag);
 
3338
                                    _ ->
 
3339
                                        Ct
 
3340
                                end
2984
3341
                         }
2985
3342
                end;
2986
3343
            'ANY' ->
3018
3375
                TempNewDef#newt{tag=
3019
3376
                               merge_tags(Tag,?TAG_PRIMITIVE(?N_OBJECT_DESCRIPTOR))};
3020
3377
            'EXTERNAL' ->
3021
 
                put(external,unchecked),
 
3378
                put_once(external,unchecked),
3022
3379
                TempNewDef#newt{type=
3023
3380
                                #'Externaltypereference'{module=S#state.mname,
3024
3381
                                                         type='EXTERNAL'},
3040
3397
                                merge_tags(Tag,?TAG_PRIMITIVE(?N_ENUMERATED)),
3041
3398
                                constraint=[]};
3042
3399
            'EMBEDDED PDV' ->
3043
 
                put(embedded_pdv,unchecked),
 
3400
                put_once(embedded_pdv,unchecked),
3044
3401
                TempNewDef#newt{type=
3045
3402
                                #'Externaltypereference'{module=S#state.mname,
3046
3403
                                                         type='EMBEDDED PDV'},
3105
3462
                check_restrictedstring(S,Def,Constr),
3106
3463
                TempNewDef#newt{tag=
3107
3464
                                merge_tags(Tag,?TAG_PRIMITIVE(?N_UTF8String))};
 
3465
            'RELATIVE-OID' ->
 
3466
                check_relative_oid(S,Constr),
 
3467
                TempNewDef#newt{tag=
 
3468
                                merge_tags(Tag,?TAG_PRIMITIVE(?'N_RELATIVE-OID'))};
3108
3469
            'CHARACTER STRING' ->
3109
 
                put(character_string,unchecked),
 
3470
                put_once(character_string,unchecked),
3110
3471
                TempNewDef#newt{type=
3111
3472
                                #'Externaltypereference'{module=S#state.mname,
3112
3473
                                                         type='CHARACTER STRING'},
3125
3486
                    check_sequence(S#state{recordtopname=
3126
3487
                                           RecordName},
3127
3488
                                           Type,Seq#'SEQUENCE'.components),
3128
 
                TempNewDef#newt{type=Seq#'SEQUENCE'{tablecinf=TableCInf,
 
3489
                TempNewDef#newt{type=Seq#'SEQUENCE'{tablecinf=tablecinf_choose(Seq,TableCInf),
3129
3490
                                          components=Components},
3130
3491
                                tag=
3131
3492
                                merge_tags(Tag,?TAG_CONSTRUCTED(?N_SEQUENCE))};
3149
3510
                    check_set(S#state{recordtopname=RecordName},
3150
3511
                              Type,Set#'SET'.components),
3151
3512
                TempNewDef#newt{type=Set#'SET'{sorted=Sorted,
3152
 
                                     tablecinf=TableCInf,
 
3513
                                     tablecinf=tablecinf_choose(Set,TableCInf),
3153
3514
                                     components=Components},
3154
3515
                                tag=
3155
3516
                                merge_tags(Tag,?TAG_CONSTRUCTED(?N_SET))};
3201
3562
                    end,
3202
3563
                TempNewDef#newt{type=NewTypeDef,tag=Ct};
3203
3564
 
 
3565
            {'TypeFromObject',{object,Object},TypeField} ->
 
3566
                CheckedT = get_type_from_object(S,Object,TypeField),
 
3567
                TempNewDef#newt{tag=merge_tags(Tag,CheckedT#type.tag),
 
3568
                                type=CheckedT#type.def};
 
3569
 
3204
3570
            {valueset,Vtype} ->
3205
3571
                TempNewDef#newt{type={valueset,check_type(S,Type,Vtype)}};
3206
3572
            {'SelectionType',Name,T} ->
3232
3598
                 T3#type{constraint=NewConstr}
3233
3599
         end,
3234
3600
    T5 = T4#type{inlined=NewDef#newt.inlined},
3235
 
    T5#type{constraint=check_constraints(S,T5#type.constraint)}.
 
3601
    T5#type{constraint=check_constraints(S,T5#type.constraint)};
 
3602
check_type(_S,Type,Ts) ->
 
3603
    exit({error,{asn1,internal_error,Type,Ts}}).
3236
3604
 
 
3605
%% tablecinf_choose. A SEQUENCE or SET may be inserted in another
 
3606
%% SEQUENCE or SET by the COMPONENTS OF directive. If this inserted
 
3607
%% type is a referenced type that already has been checked it already
 
3608
%% has its tableconstraint information. Furthermore this information
 
3609
%% may be lost in the analysis in the new environment. Assume this
 
3610
%% SEQUENCE/SET has a simpletable constraint and a componentrelation
 
3611
%% constraint whose atlist points to the outermost component of its
 
3612
%% "standalone" definition. This will cause the analysis to fail as it
 
3613
%% will not find the right atlist component in the outermost
 
3614
%% environment in the new inlined environment.
 
3615
tablecinf_choose(SetOrSeq,false) ->
 
3616
    tablecinf_choose(SetOrSeq);
 
3617
tablecinf_choose(_, TableCInf) ->
 
3618
    TableCInf.
 
3619
tablecinf_choose(#'SET'{tablecinf=TCI}) -> 
 
3620
    TCI;
 
3621
tablecinf_choose(#'SEQUENCE'{tablecinf=TCI}) ->
 
3622
    TCI.
3237
3623
 
3238
3624
get_innertag(_S,#'ObjectClassFieldType'{type=Type}) ->
3239
3625
    case Type of
3243
3629
        _ -> []
3244
3630
    end.
3245
3631
    
 
3632
get_type_from_object(S,Object,TypeField)
 
3633
  when is_record(Object,'Externaltypereference');
 
3634
       is_record(Object,'Externalvaluereference') ->
 
3635
    {_,ObjectDef} = get_referenced_type(S,Object),
 
3636
    ObjSpec = check_object(S,ObjectDef,ObjectDef#typedef.typespec),
 
3637
    get_fieldname_element(S,ObjectDef#typedef{typespec=ObjSpec},TypeField).
 
3638
    
3246
3639
is_class(_S,#classdef{}) ->
3247
3640
    true;
3248
3641
is_class(S,#typedef{typespec=#type{def=Eref}}) 
3249
3642
  when record(Eref,'Externaltypereference')->
 
3643
    is_class(S,Eref);
 
3644
is_class(S,Eref) when record(Eref,'Externaltypereference')->
3250
3645
    {_,NextDef} = get_referenced_type(S,Eref),
3251
3646
    is_class(S,NextDef);
3252
3647
is_class(_,_) ->
3294
3689
                Constr) ->
3295
3690
    Type = get_ObjectClassFieldType(S,Fs,FieldRefList),
3296
3691
    FieldNames=get_referenced_fieldname(FieldRefList),
3297
 
    case lists:last(FieldRefList) of
 
3692
    case last_fieldname(FieldRefList) of
3298
3693
        {valuefieldreference,_} ->
3299
3694
            OCFT#'ObjectClassFieldType'{fieldname=FieldNames,
3300
3695
                                        type=Type};
3301
3696
        {typefieldreference,_} ->
3302
 
            case {catch get_unique_fieldname(#classdef{typespec=ClassSpec}),
 
3697
            case {catch get_unique_fieldname(S,#classdef{typespec=ClassSpec}),
3303
3698
                  asn1ct_gen:get_constraint(Constr,componentrelation)}of
3304
 
                {Tuple,_} when tuple(Tuple) ->
 
3699
                {Tuple,_} when tuple(Tuple), size(Tuple) =:= 3 ->
3305
3700
                    OCFT#'ObjectClassFieldType'{fieldname=FieldNames,
3306
3701
                                                type='ASN1_OPEN_TYPE'};
3307
3702
                {_,no} ->
3313
3708
            end
3314
3709
    end.
3315
3710
 
 
3711
last_fieldname(FieldRefList) when is_list(FieldRefList) ->
 
3712
    lists:last(FieldRefList);
 
3713
last_fieldname({FieldName,_}) when is_atom(FieldName) ->
 
3714
    [A|_] = atom_to_list(FieldName),
 
3715
    case is_lowercase(A) of
 
3716
        true ->
 
3717
            {valuefieldreference,FieldName};
 
3718
        _ ->
 
3719
            {typefieldreference,FieldName}
 
3720
    end.
 
3721
 
3316
3722
is_open_type(#'ObjectClassFieldType'{type='ASN1_OPEN_TYPE'}) ->
3317
3723
    true;
3318
3724
is_open_type(#'ObjectClassFieldType'{}) ->
3355
3761
% fix me
3356
3762
instantiate_ptype(S,Ptypedef,ParaList) ->
3357
3763
    #ptypedef{args=Args,typespec=Type} = Ptypedef,
3358
 
    NewType = check_ptype(S,Ptypedef,Type),    
 
3764
    NewType = check_ptype(S,Ptypedef,Type#type{inlined=yes}),    
3359
3765
    MatchedArgs = match_args(S,Args, ParaList, []),
3360
 
    %OldArgs = S#state.parameters,
3361
 
%    NewS = S#state{type=NewType,parameters=MatchedArgs++OldArgs,abscomppath=[]},
3362
 
    NewS = S#state{type=NewType,parameters=MatchedArgs,abscomppath=[]},
 
3766
    OldArgs = S#state.parameters,
 
3767
    NewS = S#state{type=NewType,parameters=MatchedArgs++OldArgs,abscomppath=[]},
 
3768
%%    NewS = S#state{type=NewType,parameters=MatchedArgs,abscomppath=[]},
3363
3769
    check_type(NewS, Ptypedef#ptypedef{typespec=NewType}, NewType).
3364
3770
 
3365
3771
get_datastr_name(#typedef{name=N}) ->
3434
3840
%% parameter, and changes format of the actual parameter according to
3435
3841
%% above table if necessary.
3436
3842
match_args(S,FA = [FormArg|Ft], AA = [ActArg|At], Acc) ->
 
3843
    OldParams = S#state.parameters,
3437
3844
    case categorize_arg(S,FormArg,ActArg) of
3438
3845
        [CategorizedArg] -> 
3439
 
            match_args(S,Ft, At, [{FormArg,CategorizedArg}|Acc]);
 
3846
            match_args(S#state{parameters=
 
3847
                               [{FormArg,CategorizedArg}|OldParams]},
 
3848
                       Ft, At, [{FormArg,CategorizedArg}|Acc]);
3440
3849
        CategorizedArgs ->
3441
 
            match_args(S,FA, CategorizedArgs ++ AA, Acc)
 
3850
            match_args(S#state{parameters=CategorizedArgs++OldParams},
 
3851
                       FA, CategorizedArgs ++ AA, Acc)
3442
3852
    end;
3443
 
match_args(_,[], [], Acc) ->
 
3853
match_args(_S,[], [], Acc) ->
3444
3854
    lists:reverse(Acc);
3445
3855
match_args(_,_, _, _) ->
3446
3856
    throw({error,{asn1,{wrong_number_of_arguments}}}).
3447
3857
 
3448
3858
%%%%%%%%%%%%%%%%%
3449
 
%% categorize_arg(FormalArg,ActualArg) -> {FormalArg,CatgorizedActualArg}
 
3859
%% categorize_arg(S,FormalArg,ActualArg) -> {FormalArg,CatgorizedActualArg}
3450
3860
%%
3451
 
categorize_arg(S,{Governor,_},ActArg) ->
3452
 
    case {governor_category(S,Governor),parameter_name_style(ActArg)} of
 
3861
categorize_arg(S,{Governor,Param},ActArg) ->
 
3862
    case {governor_category(S,Governor),parameter_name_style(Param,ActArg)} of
3453
3863
        {absent,beginning_uppercase} -> %% a type
3454
 
            categorize(type,ActArg);
 
3864
            categorize(S,type,ActArg);
3455
3865
        {type,beginning_lowercase} -> %% a value
3456
 
            categorize(value,ActArg);
 
3866
            categorize(S,value,Governor,ActArg);
3457
3867
        {type,beginning_uppercase} -> %% a value set
3458
 
            categorize(value_set,ActArg);
 
3868
            categorize(S,value_set,ActArg);
3459
3869
        {absent,entirely_uppercase} -> %% a class
3460
 
            categorize(class,ActArg);
3461
 
        {class,beginning_lowercase} -> 
3462
 
            categorize(object,ActArg);
3463
 
        {class,beginning_uppercase} ->
3464
 
            categorize(object_set,ActArg);
 
3870
            categorize(S,class,ActArg);
 
3871
        {{class,ClassRef},beginning_lowercase} -> 
 
3872
            categorize(S,object,ActArg,ClassRef);
 
3873
        {{class,ClassRef},beginning_uppercase} ->
 
3874
            categorize(S,object_set,ActArg,ClassRef);
3465
3875
        _ ->
3466
3876
            [ActArg]
3467
3877
    end;
3468
 
categorize_arg(_S,FormalArg,ActualArg) ->
 
3878
categorize_arg(S,FormalArg,ActualArg) ->
3469
3879
    %% governor is absent => a type or a class
3470
3880
    case FormalArg of
3471
3881
        #'Externaltypereference'{type=Name} ->
3472
3882
            case is_class_name(Name) of
3473
3883
                true ->
3474
 
                    categorize(class,ActualArg);
 
3884
                    categorize(S,class,ActualArg);
3475
3885
                _ ->
3476
 
                    categorize(type,ActualArg)
 
3886
                    categorize(S,type,ActualArg)
3477
3887
            end;
3478
3888
        FA ->
3479
3889
            throw({error,{unexpected_formal_argument,FA}})
3480
3890
    end.
3481
 
            
 
3891
 
 
3892
governor_category(S,#type{def=Eref}) 
 
3893
  when is_record(Eref,'Externaltypereference') ->   
 
3894
    governor_category(S,Eref);
3482
3895
governor_category(_S,#type{}) ->
3483
3896
    type;
3484
3897
governor_category(S,Ref) when is_record(Ref,'Externaltypereference') ->
3485
3898
    case is_class(S,Ref) of
3486
3899
        true ->
3487
 
            class;
 
3900
            {class,Ref};
3488
3901
        _ ->
3489
3902
            type
3490
3903
    end;
3494
3907
%% governor_category(_,_) ->
3495
3908
%%     absent.
3496
3909
 
3497
 
%% parameter_name_style(Data) -> Result
3498
 
%% gets the name of the Data and if it exists tells whether it
3499
 
%% begins with a lowercase letter or is partly or entirely 
 
3910
%% parameter_name_style(Param,Data) -> Result
 
3911
%% gets the Parameter and the name of the Data and if it exists tells
 
3912
%% whether it begins with a lowercase letter or is partly or entirely
3500
3913
%% spelled with uppercase letters. Otherwise returns undefined
3501
3914
%%
3502
 
parameter_name_style(#'Externaltypereference'{type=Name}) ->
3503
 
    name_category(Name);
3504
 
parameter_name_style(#'Externalvaluereference'{value=Name}) ->
3505
 
    name_category(Name);
3506
 
parameter_name_style(_) ->
 
3915
parameter_name_style(_,#'Externaltypereference'{type=Name}) ->
 
3916
    name_category(Name);
 
3917
parameter_name_style(_,#'Externalvaluereference'{value=Name}) ->
 
3918
    name_category(Name);
 
3919
parameter_name_style(_,{valueset,_}) ->
 
3920
    %% It is a object set or value set
 
3921
    beginning_uppercase;
 
3922
parameter_name_style(#'Externalvaluereference'{},_) ->
 
3923
    beginning_lowercase;
 
3924
parameter_name_style(#'Externaltypereference'{type=Name},_) ->
 
3925
    name_category(Name);
 
3926
parameter_name_style(_,_) ->
3507
3927
    undefined.
3508
3928
 
3509
3929
name_category(Atom) when is_atom(Atom) ->
3523
3943
name_category(_) ->
3524
3944
    undefined.
3525
3945
 
3526
 
is_lowercase(X) when X >= $a,X =< $w ->
3527
 
    true;
 
3946
is_lowercase(X) when X >= $A,X =< $W ->
 
3947
    false;
3528
3948
is_lowercase(_) ->
3529
 
    false.
 
3949
    true.
3530
3950
 
3531
3951
is_class_name(Name) when is_atom(Name) ->
3532
3952
    is_class_name(atom_to_list(Name));
3538
3958
            false
3539
3959
    end.
3540
3960
                
3541
 
%% categorize(Category,Parameter) -> CategorizedParameter
 
3961
%% categorize(S,Category,Parameter) -> CategorizedParameter
3542
3962
%% If Parameter has an abstract syntax of another category than
3543
3963
%% Category, transform it to a known syntax.
3544
 
categorize(type,{object,_,Type}) ->
 
3964
categorize(_S,type,{object,_,Type}) ->
3545
3965
    %% One example of this case is an object with a parameterized type
3546
3966
    %% having a locally defined type as parameter.
3547
 
    Def = fun(#type{def=D}) ->
3548
 
                  D;
 
3967
    Def = fun(D = #type{}) ->
 
3968
                  #typedef{name = new_reference_name("type_argument"),
 
3969
                           typespec = D#type{inlined=yes}};
 
3970
             ({setting,_,Eref}) when is_record(Eref,'Externaltypereference') ->
 
3971
                  Eref;
3549
3972
             (D) ->
3550
3973
                  D
3551
3974
          end,
3552
3975
    [Def(X)||X<-Type];
3553
 
categorize(_,Def) ->
 
3976
categorize(_S,type,Def) when is_record(Def,type) ->
 
3977
    [#typedef{name = new_reference_name("type_argument"),
 
3978
              typespec = Def#type{inlined=yes}}];
 
3979
categorize(_,_,Def) ->
3554
3980
    [Def].
 
3981
categorize(S,object_set,Def,ClassRef) ->
 
3982
    %% XXXXXXXXXX
 
3983
    case Def of
 
3984
        {'Externaltypereference',undefined,'MSAccessProtocol','AllOperations'} ->
 
3985
            ok;
 
3986
        _ ->
 
3987
            ok
 
3988
    end,
 
3989
    NewObjSetSpec = 
 
3990
        check_object(S,Def,#'ObjectSet'{class = ClassRef,
 
3991
                                        set = parse_objectset(Def)}),
 
3992
    Name = new_reference_name("object_set_argument"),
 
3993
    %% XXXXXXXXXX
 
3994
    case Name of
 
3995
        internal_object_set_argument_78 ->
 
3996
            ok;
 
3997
        internal_object_set_argument_77 ->
 
3998
            ok;
 
3999
        _ ->
 
4000
            ok
 
4001
    end,
 
4002
    [save_object_set_instance(S,Name,NewObjSetSpec)];
 
4003
categorize(_S,object,Def,_ClassRef) ->
 
4004
    %% should be handled
 
4005
    [Def];
 
4006
categorize(_S,value,_Type,Value) when is_record(Value,valuedef) ->
 
4007
    [Value];
 
4008
categorize(S,value,Type,Value) ->
 
4009
%%    [check_value(S,#valuedef{type=Type,value=Value})].
 
4010
    [#valuedef{type=Type,value=Value,module=S#state.mname}].
 
4011
 
 
4012
 
 
4013
parse_objectset({valueset,T=#type{}}) ->
 
4014
    [T];
 
4015
parse_objectset({valueset,Set}) ->
 
4016
    Set;
 
4017
parse_objectset(#type{def=Ref}) when is_record(Ref,'Externaltypereference') ->
 
4018
    Ref;
 
4019
parse_objectset(Set) ->
 
4020
    %% extend this later
 
4021
    Set.
3555
4022
 
3556
4023
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3557
4024
%% check_constraints/2
3574
4041
    Id = match_parameters(S,Val, S#state.parameters),
3575
4042
    resolv_value1(S,Id).
3576
4043
 
3577
 
resolv_value1(S = #state{mname=M,inputmodules=InpMods},
3578
 
              #'Externalvaluereference'{pos=Pos,module=ExtM,value=Name}) ->
3579
 
    case ExtM of
3580
 
        M -> resolv_value2(S,M,Name,Pos);
 
4044
resolv_value1(S, ERef = #'Externalvaluereference'{value=Name}) ->
 
4045
    case catch resolve_namednumber(S,S#state.type,Name) of
 
4046
        V when integer(V) -> V;
3581
4047
        _ ->
3582
 
            case lists:member(ExtM,InpMods) of
3583
 
                true ->
3584
 
                    resolv_value2(S,M,Name,Pos);
3585
 
                false ->
3586
 
                    %V
3587
 
                    resolv_value2(update_state(S,ExtM),ExtM,Name,Pos)
 
4048
            case get_referenced_type(S,ERef) of
 
4049
                {Err,_Reason} when Err == error; Err == 'EXIT' ->
 
4050
                    throw({error,{asn1,{undefined_type_or_value,
 
4051
                                Name}}});
 
4052
                {_M,VDef} ->
 
4053
                    resolv_value1(S,VDef)
3588
4054
            end
3589
 
    end;    
 
4055
    end;
3590
4056
resolv_value1(S,{gt,V}) ->
3591
4057
    case V of
3592
4058
        Int when integer(Int) ->
3609
4075
                                                     FieldName}]}) ->
3610
4076
    %% FieldName can hold either a fixed-type value or a variable-type value
3611
4077
    %% Object is a DefinedObject, i.e. a #'Externaltypereference'
 
4078
    resolve_value_from_object(S,Object,FieldName);
 
4079
resolv_value1(_,#valuedef{checked=true,value=V}) ->
 
4080
    V;
 
4081
resolv_value1(S,#valuedef{type=_T,
 
4082
                          value={'ValueFromObject',{object,Object},
 
4083
                                 [{valuefieldreference,
 
4084
                                   FieldName}]}}) ->
 
4085
    resolve_value_from_object(S,Object,FieldName);
 
4086
resolv_value1(S,VDef = #valuedef{}) ->
 
4087
    #valuedef{value=Val} = check_value(S,VDef),
 
4088
    Val;
 
4089
resolv_value1(_,V) ->
 
4090
    V.
 
4091
resolve_value_from_object(S,Object,FieldName) ->
3612
4092
    {_,ObjTDef} = get_referenced_type(S,Object),
3613
4093
    TS = check_object(S,ObjTDef,ObjTDef#typedef.typespec),
3614
4094
    {_,_,Components} = TS#'Object'.def,
3617
4097
            Val;
3618
4098
        _ ->
3619
4099
            error({value,"illegal value in constraint",S})
3620
 
    end;
3621
 
% resolv_value1(S,{'ValueFromObject',{po,Object,Params},FieldName}) ->
3622
 
%     %% FieldName can hold either a fixed-type value or a variable-type value
3623
 
%     %% Object is a ParameterizedObject
3624
 
resolv_value1(_,V) ->
3625
 
    V.
3626
 
 
3627
 
resolv_value2(S,ModuleName,Name,Pos) ->
3628
 
    case asn1_db:dbget(ModuleName,Name) of
3629
 
        undefined ->
3630
 
            case imported(S,Name) of 
3631
 
                {ok,Imodule} ->
3632
 
                    {M2,V2} = get_referenced(S,Imodule,Name,Pos),
3633
 
                    case V2#valuedef.value of
3634
 
                        #'Externalvaluereference'{value=N2} ->
3635
 
                            resolv_value2(update_state(S,M2),M2,N2,Pos);
3636
 
                        _ ->
3637
 
                            V2#valuedef.value
3638
 
                    end;
3639
 
                _ -> %% May be a name in an enumerations list of a
3640
 
                     %% referenced type.
3641
 
                    case catch resolve_namednumber(S,S#state.type,Name) of
3642
 
                        V when integer(V) -> V;
3643
 
                        _ ->
3644
 
                            throw({error,{asn1,{undefined_type_or_value,
3645
 
                                                Name}}})
3646
 
                    end
3647
 
            end;
3648
 
        Val ->
3649
 
            Val#valuedef.value
3650
4100
    end.
3651
4101
 
 
4102
 
 
4103
 
3652
4104
resolve_namednumber(S,#typedef{typespec=Type},Name) ->
3653
4105
    case Type#type.def of
3654
4106
        {'ENUMERATED',NameList} ->
3673
4125
check_constraints(S,[C | Rest], Acc) ->
3674
4126
    check_constraints(S,Rest,[check_constraint(S,C) | Acc]);
3675
4127
check_constraints(S,[],Acc) ->
3676
 
%    io:format("Acc: ~p~n",[Acc]),
3677
 
    C = constraint_merge(S,lists:reverse(Acc)),
3678
 
%    io:format("C: ~p~n",[C]),
3679
 
    lists:flatten(C).
 
4128
    constraint_merge(S,Acc).
3680
4129
 
3681
4130
 
3682
4131
range_check(F={FixV,FixV}) ->
3726
4175
%% In case of a constraint with extension marks like (1..Ub,...)
3727
4176
check_constraint(S,{VR={'ValueRange', {_Lb, _Ub}},Rest}) ->
3728
4177
    {check_constraint(S,VR),Rest};
 
4178
check_constraint(_S,{'PermittedAlphabet',PA}) ->
 
4179
    {'PermittedAlphabet',permitted_alphabet_cnstr(PA)};
3729
4180
 
3730
4181
check_constraint(S,{valueset,Type}) ->
3731
4182
    {valueset,check_type(S,S#state.tname,Type)};
3732
4183
 
 
4184
check_constraint(_S,ST={simpletable,Type}) when is_atom(Type) ->
 
4185
    %% An already checked constraint
 
4186
    ST;
3733
4187
check_constraint(S,{simpletable,Type}) ->
3734
4188
    Def = case Type of
3735
4189
              #type{def=D} -> D;
3754
4208
                    exit({error,{internal_error,Err}})
3755
4209
            end;
3756
4210
        #'Externalvaluereference'{} ->
3757
 
            {_,TDef} = get_referenced_type(S,C),
3758
 
            case TDef#typedef.typespec of
3759
 
                Obj = #'Object'{} -> 
3760
 
                    {simpletable,
3761
 
                     check_object(S,Type,
3762
 
                                  #'ObjectSet'{class=Obj#'Object'.classname,
3763
 
                                               set={'SingleValue',C}})};
3764
 
                Err ->
3765
 
                    exit({error,{internal_error,Err}})
3766
 
            end;
 
4211
            %% This is an object set with a referenced object
 
4212
            {_,TorVDef} = get_referenced_type(S,C),
 
4213
            GetObjectSet = 
 
4214
                fun(#typedef{typespec=O}) when is_record(O,'Object') ->
 
4215
                        #'ObjectSet'{class=O#'Object'.classname,
 
4216
                                     set={'SingleValue',C}};
 
4217
                   (#valuedef{type=Cl,value=O}) 
 
4218
                   when is_record(O,'Externalvaluereference'),
 
4219
                        is_record(Cl,type) ->
 
4220
                        %% an object might reference another object
 
4221
                        #'ObjectSet'{class=Cl#type.def,
 
4222
                                     set={'SingleValue',O}};
 
4223
                   (Err) -> 
 
4224
                        exit({error,{internal_error,simpletable_constraint,Err}})
 
4225
                end,
 
4226
            ObjSet = GetObjectSet(TorVDef),
 
4227
            {simpletable,check_object(S,Type,ObjSet)};
 
4228
        #'ObjectSet'{} ->
 
4229
            io:format("ALERT: simpletable forbidden case!~n",[]),
 
4230
            {simpletable,check_object(S,Type,C)};
 
4231
        {'ValueFromObject',{_,ORef},FieldName} ->
 
4232
            %% This is an ObjectFromObject
 
4233
            {_,Object} = get_referenced_type(S,ORef),
 
4234
            ChObject = check_object(S,Object,
 
4235
                                    Object#typedef.typespec),
 
4236
            ObjFromObj=
 
4237
                get_fieldname_element(S,Object#typedef{
 
4238
                                          typespec=ChObject},
 
4239
                                      FieldName),
 
4240
            {simpletable,ObjFromObj};
 
4241
%%           ObjFromObj#typedef{checked=true,typespec=
 
4242
%%                              check_object(S,ObjFromObj,
 
4243
%%                                           ObjFromObj#typedef.typespec)}};
3767
4244
        _ -> 
3768
4245
            check_type(S,S#state.tname,Type),%% this seems stupid.
3769
4246
            OSName = Def#'Externaltypereference'.type,
3794
4271
%    io:format("Constraint = ~p~n",[Any]),
3795
4272
    Any.
3796
4273
 
 
4274
permitted_alphabet_cnstr(T) when is_tuple(T) ->
 
4275
    permitted_alphabet_cnstr([T]);
 
4276
permitted_alphabet_cnstr(L) when is_list(L) ->
 
4277
    VRexpand = fun({'ValueRange',{A,B}}) ->
 
4278
                       {'SingleValue',expand_valuerange(A,B)};
 
4279
                  (Other) ->
 
4280
                       Other
 
4281
               end,
 
4282
    L2 = lists:map(VRexpand,L),
 
4283
    %% first perform intersection
 
4284
    L3 = permitted_alphabet_intersection(L2),
 
4285
    [Res] = permitted_alphabet_union(L3),
 
4286
    Res.
 
4287
 
 
4288
expand_valuerange([A],[A]) ->
 
4289
    [A];
 
4290
expand_valuerange([A],[B]) when A < B ->
 
4291
    [A|expand_valuerange([A+1],[B])].
 
4292
 
 
4293
permitted_alphabet_intersection(C) ->
 
4294
    permitted_alphabet_merge(C,intersection, []).
 
4295
 
 
4296
permitted_alphabet_union(C) ->
 
4297
    permitted_alphabet_merge(C,union, []).
 
4298
 
 
4299
permitted_alphabet_merge([],_,Acc) ->
 
4300
    lists:reverse(Acc);
 
4301
permitted_alphabet_merge([{'SingleValue',L1},
 
4302
                          UorI,
 
4303
                          {'SingleValue',L2}|Rest],UorI,Acc)
 
4304
  when is_list(L1),is_list(L2) ->
 
4305
    UI = ordsets:UorI([ordsets:from_list(L1),ordsets:from_list(L2)]),
 
4306
    permitted_alphabet_merge([{'SingleValue',UI}|Rest],UorI,Acc);
 
4307
permitted_alphabet_merge([C1|Rest],UorI,Acc) ->
 
4308
    permitted_alphabet_merge(Rest,UorI,[C1|Acc]).
 
4309
 
 
4310
 
3797
4311
%% constraint_merge/2
3798
4312
%% Compute the intersection of the outermost level of the constraint list.
3799
4313
%% See Dubuisson second paragraph and fotnote on page 285.
3807
4321
constraint_merge(_S,[]) ->
3808
4322
    [];
3809
4323
constraint_merge(S,C) ->
3810
 
    %% skip all extension but the last
 
4324
    %% skip all extension but the last extension
3811
4325
    C1 = filter_extensions(C),
3812
4326
    %% perform all internal level intersections, intersections first
3813
4327
    %% since they have precedence over unions
3836
4350
                             ordsets:from_list(SZs)),
3837
4351
    %% get the least common combined constraint. That is the union of each
3838
4352
    %% deep costraint and merge of single value and value range constraints
3839
 
    combine_constraints(S,CombSV,CombVR,CombSZ++RestC).
 
4353
    NewCs = combine_constraints(S,CombSV,CombVR,CombSZ++RestC),
 
4354
    [X||X <- lists:flatten(NewCs),
 
4355
        X /= intersection,
 
4356
        X /= union].
3840
4357
 
3841
4358
%% constraint_union(S,C) takes a list of constraints as input and
3842
4359
%% merge them to a union. Unions are performed when two
4021
4538
 
4022
4539
 
4023
4540
%% filter_extensions(C)
4024
 
%% takes a list of constraints as input and
4025
 
%% returns a list with the intersection of all extension roots
4026
 
%% and only the extension of the last constraint kept if any 
4027
 
%% extension in the last constraint
 
4541
%% takes a list of constraints as input and returns a list with the
 
4542
%% constraints and all extensions but the last are removed.
 
4543
filter_extensions([L]) when is_list(L) ->
 
4544
    [filter_extensions(L)];
4028
4545
filter_extensions(C=[_H]) ->
4029
4546
    C;
4030
4547
filter_extensions(C) when list(C) ->
4031
 
    filter_extensions(C,[]).
 
4548
    filter_extensions(C,[], []).
4032
4549
 
4033
 
filter_extensions([C],Acc) ->
4034
 
    lists:reverse([C|Acc]);
4035
 
filter_extensions([{C,_E},H2|T],Acc) when tuple(C) ->
4036
 
    filter_extensions([H2|T],[C|Acc]);
4037
 
filter_extensions([{'SizeConstraint',{A,_B}},H2|T],Acc) 
 
4550
filter_extensions([],Acc,[]) ->
 
4551
    Acc;
 
4552
filter_extensions([],Acc,[EC|ExtAcc]) ->
 
4553
    CwoExt = remove_extension(ExtAcc,[]),
 
4554
    CwoExt ++ [EC|Acc];
 
4555
filter_extensions([C={A,_E}|T],Acc,ExtAcc) when tuple(A) ->
 
4556
    filter_extensions(T,Acc,[C|ExtAcc]);
 
4557
filter_extensions([C={'SizeConstraint',{A,_B}}|T],Acc,ExtAcc) 
4038
4558
  when list(A);tuple(A) ->
4039
 
    filter_extensions([H2|T],[{'SizeConstraint',A}|Acc]);
4040
 
filter_extensions([H1,H2|T],Acc) ->
4041
 
    filter_extensions([H2|T],[H1|Acc]).
 
4559
    filter_extensions(T,Acc,[C|ExtAcc]);
 
4560
filter_extensions([C={'PermittedAlphabet',{{'SingleValue',_},E}}|T],Acc,ExtAcc)
 
4561
  when is_tuple(E); is_list(E) ->
 
4562
    filter_extensions(T,Acc,[C|ExtAcc]);
 
4563
filter_extensions([H|T],Acc,ExtAcc) ->
 
4564
    filter_extensions(T,[H|Acc],ExtAcc).
 
4565
 
 
4566
remove_extension([],Acc) ->
 
4567
    Acc;
 
4568
remove_extension([{'SizeConstraint',{A,_B}}|R],Acc) ->
 
4569
    remove_extension(R,[{'SizeConstraint',A}|Acc]);
 
4570
remove_extension([{C,_E}|R],Acc) when is_tuple(C) ->
 
4571
    remove_extension(R,[C|Acc]);
 
4572
remove_extension([{'PermittedAlphabet',{A={'SingleValue',_},
 
4573
                                        E}}|R],Acc) 
 
4574
  when is_tuple(E);is_list(E) ->
 
4575
    remove_extension(R,[{'PermittedAlphabet',A}|Acc]).
4042
4576
 
4043
4577
%% constraint_intersection(S,C) takes a list of constraints as input and
4044
4578
%% performs intersections. Intersecions are performed when an 
4124
4658
    end.
4125
4659
 
4126
4660
 
 
4661
%% Size constraint [{'SizeConstraint',1},{'SizeConstraint',{{1,64},[]}}]
4127
4662
 
4128
4663
intersection_of_size(_,[]) ->
4129
4664
    [];
4137
4672
        {Lb,Ub} when Int >= Lb,
4138
4673
                     Int =< Ub ->
4139
4674
            intersection_of_size(S,[C1|Rest]);
 
4675
        {{Lb,Ub},Ext} when is_list(Ext),Int >= Lb,Int =< Ub ->
 
4676
            intersection_of_size(S,[C1|Rest]);
4140
4677
        _ ->
4141
4678
            throw({error,{asn1,{illegal_size_constraint,C}}})
4142
4679
    end;
4221
4758
    false.
4222
4759
    
4223
4760
 
4224
 
 
4225
 
check_imported(_S,Imodule,Name) ->
 
4761
check_imported(S,Imodule,Name) ->
 
4762
    check_imported(S,Imodule,Name,false).
 
4763
check_imported(S,Imodule,Name,IsParsed) ->
4226
4764
    case asn1_db:dbget(Imodule,'MODULE') of
 
4765
        undefined when IsParsed == true ->
 
4766
            ErrStr = io_lib:format("Type ~s imported from non existing module ~s~n",[Name,Imodule]),
 
4767
            error({imported,ErrStr,S});
4227
4768
        undefined ->
4228
 
            io:format("~s.asn1db not found~n",[Imodule]),
4229
 
            io:format("Type ~s imported from non existing module ~s~n",[Name,Imodule]);
 
4769
            parse_and_save(S,Imodule),
 
4770
            check_imported(S,Imodule,Name,true);
4230
4771
        Im when record(Im,module) ->
4231
4772
            case is_exported(Im,Name) of
4232
4773
                false ->
4233
 
                    io:format("Imported type ~s not exported from module ~s~n",[Name,Imodule]);
 
4774
                    ErrStr = io_lib:format("Imported type ~s not exported from module ~s~n",[Name,Imodule]),
 
4775
                    error({imported,ErrStr,S});
4234
4776
                _ ->
4235
4777
                    ok
4236
4778
            end
4252
4794
    end.
4253
4795
    
4254
4796
 
4255
 
 
4256
4797
check_externaltypereference(S,Etref=#'Externaltypereference'{module=Emod})->
4257
4798
    Currmod = S#state.mname,
4258
4799
    MergedMods = S#state.inputmodules,
4266
4807
                true ->
4267
4808
                    check_reference(S,Etref);
4268
4809
                false ->
4269
 
                    Etref
 
4810
                    {NewMod,_} = get_referenced_type(S,Etref),
 
4811
                    Etref#'Externaltypereference'{module=NewMod}
4270
4812
            end
4271
4813
    end.
4272
4814
 
4276
4818
        undefined ->
4277
4819
            case imported(S,Name) of
4278
4820
                {ok,Imodule} ->
4279
 
                    check_imported(S,Imodule,Name),
4280
 
                    #'Externaltypereference'{module=Imodule,type=Name};
 
4821
                    case check_imported(S,Imodule,Name) of
 
4822
                        ok ->
 
4823
                            #'Externaltypereference'{module=Imodule,type=Name};
 
4824
                        Err ->
 
4825
                            Err
 
4826
                    end;
4281
4827
                _ ->
4282
4828
                    %may be a renamed type in multi file compiling!
4283
4829
                    {M,T}=get_renamed_reference(S,Name,Emod),
4296
4842
    end.
4297
4843
 
4298
4844
 
4299
 
% name2Extref(_Mod,Name) when record(Name,'Externaltypereference') ->
4300
 
%     Name;
4301
 
% name2Extref(Mod,Name) ->
4302
 
%     #'Externaltypereference'{module=Mod,type=Name}.
4303
 
 
4304
4845
get_referenced_type(S,Ext) when record(Ext,'Externaltypereference') ->
4305
4846
    case match_parameters(S,Ext, S#state.parameters) of
4306
4847
        Ext -> 
4438
4979
 
4439
4980
check_and_save(S,#'Externaltypereference'{module=M}=ERef,#typedef{checked=false}=TDef,Settings)
4440
4981
  when S#state.mname /= M ->
 
4982
    %% This ERef is an imported type (or maybe a set.asn compilation)
4441
4983
    NewS = S#state{mname=M,module=load_asn1_module(S,M),
4442
4984
                   type=TDef,tname=get_datastr_name(TDef)},
4443
4985
    Type=check_type(NewS,TDef,TDef#typedef.typespec),%XXX
4444
4986
    CheckedTDef = TDef#typedef{checked=true,
4445
4987
                               typespec=Type},
4446
4988
    asn1_db:dbput(M,get_datastr_name(TDef),CheckedTDef),
4447
 
    {ERef,Settings};
4448
 
check_and_save(S,#'Externaltypereference'{module=M,type=N}=Eref,#ptypedef{checked=false,name=Name,args=Params} = PTDef,Settings) ->
 
4989
    {merged_name(S,ERef),Settings};
 
4990
check_and_save(S,#'Externaltypereference'{module=M,type=N}=Eref,
 
4991
               #ptypedef{name=Name,args=Params} = PTDef,Settings) ->
4449
4992
    %% instantiate a parameterized type
4450
4993
    %% The parameterized type should be saved as a type in the module
4451
4994
    %% it was instantiated.
4457
5000
    ERefNew = #'Externaltypereference'{type=ERefName,module=S#state.mname},
4458
5001
    NewTDef=#typedef{checked=true,name=ERefName,
4459
5002
                     typespec=Type},
4460
 
    asn1ct_gen:insert_once(parameterized_objects,{ERefName,type,NewTDef}),
 
5003
    insert_once(S,parameterized_objects,{ERefName,type,NewTDef}),
4461
5004
    asn1_db:dbput(S#state.mname,ERefNew#'Externaltypereference'.type,
4462
5005
                  NewTDef),
4463
5006
    {ERefNew,RestSettings};
4464
 
check_and_save(_S,ERef,_TDef,Settings) ->
4465
 
    {ERef,Settings}.
 
5007
check_and_save(_S,ERef,TDef,Settings) ->
 
5008
    %% This might be a renamed type in a set of specs, so rename the ERef
 
5009
    {ERef#'Externaltypereference'{type=asn1ct:get_name_of_def(TDef)},Settings}.
4466
5010
 
 
5011
save_object_set_instance(S,Name,ObjSetSpec) 
 
5012
  when is_record(ObjSetSpec,'ObjectSet') ->
 
5013
    NewObjSet = #typedef{checked=true,name=Name,typespec=ObjSetSpec},
 
5014
    asn1_db:dbput(S#state.mname,Name,NewObjSet),
 
5015
    case ObjSetSpec of
 
5016
        #'ObjectSet'{uniquefname={unique,undefined}} ->
 
5017
            ok;
 
5018
        _ ->
 
5019
            %% Should be generated iff 
 
5020
            %% ObjSpec#'ObjectSet'.uniquefname /= {unique,undefined}
 
5021
            ObjSetKey = {Name,objectset,NewObjSet},
 
5022
            %% asn1ct_gen:insert_once(parameterized_objects,ObjSetKey)
 
5023
            insert_once(S,parameterized_objects,ObjSetKey)
 
5024
    end,
 
5025
    #'Externaltypereference'{module=S#state.mname,type=Name}.
 
5026
    
4467
5027
%% load_asn1_module do not check that the module is saved.
4468
5028
%% If get_referenced_type is called before the module must
4469
5029
%% be saved. 
4504
5064
put_asn1db_uptodate(L) ->
4505
5065
    put(asn1db_uptodate,L).
4506
5066
 
 
5067
update_state(S,undefined) ->
 
5068
    S;
4507
5069
update_state(S=#state{mname=ModuleName},ModuleName) ->
4508
5070
    S;
4509
5071
update_state(S,ModuleName) ->
4510
 
    parse_and_save(S,ModuleName),
4511
 
    case asn1_db:dbget(ModuleName,'MODULE') of
4512
 
        RefedMod when record(RefedMod,module) ->
4513
 
            S#state{mname=ModuleName,module=RefedMod};
4514
 
        _ -> throw({error,{asn1,{module_does_not_exist,ModuleName}}})
 
5072
    case lists:member(ModuleName,S#state.inputmodules) of
 
5073
        true ->
 
5074
            S;
 
5075
        _ ->
 
5076
            parse_and_save(S,ModuleName),
 
5077
            case asn1_db:dbget(ModuleName,'MODULE') of
 
5078
                RefedMod when record(RefedMod,module) ->
 
5079
                    S#state{mname=ModuleName,module=RefedMod};
 
5080
                _ -> throw({error,{asn1,{module_does_not_exist,ModuleName}}})
 
5081
            end
4515
5082
    end.
4516
5083
 
4517
5084
 
4616
5183
 
4617
5184
            ObjectSet = #'ObjectSet'{class=RightClassRef,set=T},
4618
5185
            ObjSpec = check_object(S,#typedef{typespec=ObjectSet},ObjectSet),
4619
 
            Name = list_to_atom(asn1ct_gen:list2name([get_datastr_name(ObjDef)|S#state.recordtopname])),            
4620
 
            NewObj = #typedef{checked=true,name=Name,typespec=ObjSpec},
4621
 
            asn1_db:dbput(S#state.mname,Name,NewObj),
4622
 
            %% Should be generated iff 
4623
 
            %% ObjSpec#'ObjectSet'.uniquefname /= {unique,undefined}
4624
 
            case ObjSpec of
4625
 
                #'ObjectSet'{uniquefname={unique,undefined}} ->
4626
 
                    ok;
4627
 
                _ ->
4628
 
                    asn1ct_gen:insert_once(parameterized_objects,
4629
 
                                           {Name,objectset,NewObj})
4630
 
            end,
4631
 
            #'Externaltypereference'{module=S#state.mname,type=Name};
 
5186
            Name = list_to_atom(asn1ct_gen:list2name([get_datastr_name(ObjDef)|S#state.recordtopname])),         
 
5187
            save_object_set_instance(S,Name,ObjSpec);
4632
5188
        pvaluesetdef -> error({pvaluesetdef,"parameterized valueset",S});
4633
5189
        {error,_Reason} -> error({type,"error in parameter",S});
4634
5190
        Ts when record(Ts,type) -> Ts#type.def
4658
5214
        
4659
5215
 
4660
5216
check_integer(_S,[],_C) ->
4661
 
    ok;
 
5217
    [];
4662
5218
check_integer(S,NamedNumberList,_C) ->
4663
 
    case check_unique(NamedNumberList,2) of
4664
 
        [] -> 
4665
 
            check_int(S,NamedNumberList,[]);
4666
 
        L when list(L) ->
4667
 
            error({type,{duplicates,L},S}),
4668
 
            unchanged
4669
 
                   
 
5219
    case [X||X<-NamedNumberList,is_tuple(X),size(X)=:=2] of
 
5220
        NamedNumberList ->
 
5221
            %% An already checked integer with NamedNumberList
 
5222
            NamedNumberList;
 
5223
        _ ->
 
5224
            case check_unique(NamedNumberList,2) of
 
5225
                [] -> 
 
5226
                    check_int(S,NamedNumberList,[]);
 
5227
                L when list(L) ->
 
5228
                    error({type,{duplicates,L},S}),
 
5229
                    unchanged
 
5230
            end
4670
5231
    end.
4671
5232
 
4672
 
check_int(S,[{'NamedNumber',Id,Num}|T],Acc) when integer(Num) ->
 
5233
    
 
5234
check_int(S,[{'NamedNumber',Id,Num}|T],Acc) when is_integer(Num) ->
4673
5235
    check_int(S,T,[{Id,Num}|Acc]);
4674
5236
check_int(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc) ->
4675
5237
    Val = dbget_ex(S,S#state.mname,Name),
4729
5291
check_type_identifier(S,Eref=#'Externaltypereference'{}) ->
4730
5292
    case get_referenced_type(S,Eref) of
4731
5293
        {_,#classdef{name='TYPE-IDENTIFIER'}} -> ok;
 
5294
        {_,#classdef{typespec=NextEref}} 
 
5295
        when is_record(NextEref,'Externaltypereference') ->
 
5296
            check_type_identifier(S,NextEref);
4732
5297
        {_,TD=#typedef{typespec=#type{def=#'Externaltypereference'{}}}} ->
4733
5298
            check_type_identifier(S,(TD#typedef.typespec)#type.def);
4734
 
        _ ->
 
5299
        Err ->
4735
5300
            error({type,{"object set in type INSTANCE OF "
4736
 
                         "not of class TYPE-IDENTIFIER",Eref},S})
 
5301
                         "not of class TYPE-IDENTIFIER",Eref,Err},S})
4737
5302
    end.
4738
5303
 
4739
5304
iof_associated_type(S,[]) ->
4788
5353
    ObjectIdentifier =
4789
5354
        #'ObjectClassFieldType'{classname=TypeIdentifierRef,
4790
5355
                                class=[],
 
5356
%%                              fieldname=[{valuefieldreference,id}],
4791
5357
                                fieldname={id,[]},
4792
5358
                                type={fixedtypevaluefield,id,
4793
5359
                                      #type{def='OBJECT IDENTIFIER'}}},
4794
5360
    Typefield =
4795
5361
        #'ObjectClassFieldType'{classname=TypeIdentifierRef,
4796
5362
                                class=[],
 
5363
%%                              fieldname=[{typefieldreference,'Type'}],
4797
5364
                                fieldname={'Type',[]},
4798
5365
                                type=Typefield_type},
4799
5366
    IOFComponents =
4931
5498
            %% {objfun,ERef} tuple added in NewComps2 in tablecinf
4932
5499
            %% field in type record of component relation constrained
4933
5500
            %% type
4934
 
%           io:format("NewComps: ~p~n",[NewComps]),
4935
5501
            {CRelInf,NewComps2} = componentrelation_leadingattr(S,NewComps),
4936
 
%           io:format("CRelInf: ~p~n",[CRelInf]),
4937
 
%           io:format("NewComps2: ~p~n",[NewComps2]),
 
5502
 
4938
5503
            %% CompListWithTblInf has got a lot unecessary info about
4939
5504
            %% the involved class removed, as the class of the object
4940
5505
            %% set.
4941
5506
            CompListWithTblInf = get_tableconstraint_info(S,Type,NewComps2),
4942
 
%           io:format("CompListWithTblInf: ~p~n",[CompListWithTblInf]),
 
5507
 
4943
5508
            {CRelInf,CompListWithTblInf};
4944
5509
        Dupl ->
4945
5510
                throw({error,{asn1,{duplicate_components,Dupl}}})
4971
5536
expand_components2(S,{_,PT={pt,_,_}}) ->
4972
5537
    PTType = check_type(S,PT,#type{def=PT}),
4973
5538
    expand_components2(S,{dummy,#typedef{typespec=PTType}});
 
5539
expand_components2(S,{_,OCFT = #'ObjectClassFieldType'{}}) ->
 
5540
    UncheckedType = #type{def=OCFT},
 
5541
    Type = check_type(S,#typedef{typespec=UncheckedType},UncheckedType),
 
5542
    expand_components2(S,{undefined,oCFT_def(S,Type)});
 
5543
expand_components2(S,{_,ERef}) when is_record(ERef,'Externaltypereference') ->
 
5544
    expand_components2(S,get_referenced_type(S,ERef));
4974
5545
expand_components2(_S,Err) ->
4975
5546
    throw({error,{asn1,{illegal_COMPONENTS_OF,Err}}}).
4976
5547
 
5002
5573
 
5003
5574
check_set(S,Type,Components) ->
5004
5575
    {TableCInf,NewComponents} = check_sequence(S,Type,Components),
5005
 
    check_distinct_tags(S#state.erule,NewComponents,[]),
5006
 
    case lists:member(der,S#state.options) of
5007
 
        true when S#state.erule == ber;
5008
 
                  S#state.erule == ber_bin;
5009
 
                  S#state.erule == ber_bin_v2 ->
5010
 
            {Sorted,SortedComponents} = 
5011
 
                sort_components(S,
5012
 
                                (S#state.module)#module.tagdefault,
5013
 
                                NewComponents),
 
5576
    check_distinct_tags(NewComponents,[]),
 
5577
    case {lists:member(der,S#state.options),S#state.erule} of
 
5578
        {true,_} ->
 
5579
            {Sorted,SortedComponents} = sort_components(der,S,NewComponents),
 
5580
            {Sorted,TableCInf,SortedComponents};
 
5581
        {_,PER} when PER =:= per; PER =:= per_bin; PER =:= uper_bin ->
 
5582
            {Sorted,SortedComponents} = sort_components(per,S,NewComponents),
5014
5583
            {Sorted,TableCInf,SortedComponents};
5015
5584
        _ ->
5016
5585
            {false,TableCInf,NewComponents}
5018
5587
 
5019
5588
 
5020
5589
%% check that all tags are distinct according to X.680 26.3
5021
 
check_distinct_tags(Erule,Cs,Acc) 
5022
 
  when Erule == ber; Erule == ber_bin; Erule == ber_bin_v2 ->
5023
 
    check_distinct_tags(Cs,Acc);
5024
 
check_distinct_tags(_,_,_) ->
5025
 
    ok. % should check tags even for per, fix later
5026
 
 
5027
5590
check_distinct_tags({C1,C2,C3},Acc) when is_list(C1),is_list(C2),is_list(C3) ->
5028
5591
    check_distinct_tags(C1++C2++C3,Acc);
5029
5592
check_distinct_tags({C1,C2},Acc) when list(C1),list(C2) ->
5035
5598
    check_distinct(T,Acc),
5036
5599
    check_distinct_tags([C#'ComponentType'{tags=Ts}|Cs],[T|Acc]);
5037
5600
check_distinct_tags([#'ComponentType'{tags=[]}|_Cs],_Acc) ->
5038
 
%    error({type,"Not distinct tags in SET",S});
5039
5601
    throw({error,"Not distinct tags in SET"});
5040
5602
check_distinct_tags([],_) ->
5041
5603
    ok.
5046
5608
        _ -> ok
5047
5609
    end.
5048
5610
 
5049
 
sort_components(_S,'AUTOMATIC',Components) ->
5050
 
    {true,Components};
5051
 
sort_components(S=#state{tname=TypeName},_TagDefault,Components) ->
5052
 
    case untagged_choice(S,Components) of
5053
 
        false ->
5054
 
            {true,sort_components1(TypeName,Components,[],[],[],[])};
5055
 
        true ->
5056
 
            {dynamic,Components} % sort in run-time
 
5611
%% sorting in canonical order according to X.680 8.6, X.691 9.2
 
5612
%% DER: all components shall be sorted in canonical order.
 
5613
%% PER: only root components shall be sorted in canonical order. The
 
5614
%%      extension components shall remain in textual order.
 
5615
%%
 
5616
sort_components(der,S=#state{tname=TypeName},Components) ->
 
5617
    {R1,Ext,R2} = extension(textual_order(Components)),
 
5618
    CompsList = case Ext of
 
5619
                    noext -> R1;
 
5620
                    _ -> R1 ++ Ext ++ R2
 
5621
                end,
 
5622
    case {untagged_choice(S,CompsList),Ext} of
 
5623
        {false,noext} ->
 
5624
            {true,sort_components1(TypeName,CompsList,[],[],[],[])};
 
5625
        {false,_} ->
 
5626
            {true,{sort_components1(TypeName,CompsList,[],[],[],[]), []}};
 
5627
        {true,noext} ->
 
5628
            %% sort in run-time
 
5629
            {dynamic,R1};
 
5630
        _ ->
 
5631
            {dynamic,{R1, Ext, R2}}
 
5632
    end;
 
5633
sort_components(per,S=#state{tname=TypeName},Components) ->
 
5634
    {R1,Ext,R2} = extension(textual_order(Components)),
 
5635
    Root = tag_untagged_choice(S,R1++R2),
 
5636
    case Ext of
 
5637
        noext ->
 
5638
            {true,sort_components1(TypeName,Root,[],[],[],[])};
 
5639
        _ ->
 
5640
            {true,{sort_components1(TypeName,Root,[],[],[],[]),
 
5641
                   Ext}}
5057
5642
    end.
5058
5643
 
5059
5644
sort_components1(TypeName,[C=#'ComponentType'{tags=[{'UNIVERSAL',_}|_R]}|Cs],
5131
5716
untagged_choice(_,[]) ->
5132
5717
    false.
5133
5718
    
 
5719
    
 
5720
tag_untagged_choice(S,Cs) ->
 
5721
    tag_untagged_choice(S,Cs,[]).
 
5722
tag_untagged_choice(S,[C = #'ComponentType'{typespec=#type{tag=[],def={'CHOICE',_}}}|Rest],Acc) ->
 
5723
    TagList = C#'ComponentType'.tags,
 
5724
    TaggedC = C#'ComponentType'{tags=get_least_tag(TagList)},
 
5725
    tag_untagged_choice(S,Rest,[TaggedC|Acc]);
 
5726
tag_untagged_choice(S,[C = #'ComponentType'{typespec=#type{tag=[],def=ExRef}}|Rest],Acc) when record(ExRef,'Externaltypereference') ->
 
5727
    case get_referenced_type(S,ExRef) of
 
5728
        {_,#typedef{typespec=#type{tag=[],
 
5729
                                   def={'CHOICE',_}}}} -> 
 
5730
            TagList = C#'ComponentType'.tags,
 
5731
            TaggedC = C#'ComponentType'{tags = get_least_tag(TagList)},
 
5732
            tag_untagged_choice(S,Rest,[TaggedC|Acc]);
 
5733
        _ -> 
 
5734
            tag_untagged_choice(S,Rest,[C|Acc])
 
5735
    end;
 
5736
tag_untagged_choice(S,[C|Rest],Acc) ->
 
5737
    tag_untagged_choice(S,Rest,[C|Acc]);
 
5738
tag_untagged_choice(_S,[],Acc) ->
 
5739
    Acc.
 
5740
get_least_tag([]) ->
 
5741
    [];
 
5742
get_least_tag(TagList) ->
 
5743
    %% The smallest tag 'PRIVATE' < 'CONTEXT' < 'APPLICATION' < 'UNIVERSAL'
 
5744
    Pred = fun({'PRIVATE',_},{'CONTEXT',_}) -> true;
 
5745
              ({'CONTEXT',_},{'APPLICATION',_}) -> true; 
 
5746
              ({'APPLICATION',_},{'UNIVERSAL',_}) -> true; 
 
5747
              ({A,T1},{A,T2}) when T1 =< T2 -> true; (_,_) -> false 
 
5748
           end,
 
5749
    [T|_] = lists:sort(Pred,TagList),
 
5750
    [T].
 
5751
 
 
5752
%% adds the textual order to the components to keep right order of
 
5753
%% components in the asn1-value.
 
5754
textual_order(Cs) ->
 
5755
    Fun = fun(C,Index) ->
 
5756
                  {C#'ComponentType'{textual_order=Index},Index+1}
 
5757
          end,
 
5758
    {NewCs,_} = textual_order(Cs,Fun,1),
 
5759
    NewCs.
 
5760
textual_order(Cs,Fun,IxIn) when is_list(Cs) ->
 
5761
    lists:mapfoldl(Fun,IxIn,Cs);
 
5762
textual_order({Root,Ext},Fun,IxIn) ->
 
5763
    {NewRoot,IxR} = textual_order(Root,Fun,IxIn),
 
5764
    {NewExt,_} = textual_order(Ext,Fun,IxR),
 
5765
    {{NewRoot,NewExt},dummy};
 
5766
textual_order({Root1,Ext,Root2},Fun,IxIn) ->
 
5767
    {NewRoot1,IxR} = textual_order(Root1,Fun,IxIn),
 
5768
    {NewExt,IxE} = textual_order(Ext,Fun,IxR),
 
5769
    {NewRoot2,_} = textual_order(Root2,Fun,IxE),
 
5770
    {{NewRoot1,NewExt,NewRoot2},dummy}.
 
5771
 
 
5772
extension(Components) when is_list(Components) ->
 
5773
    {Components,noext,[]};
 
5774
extension({Root,ExtList}) ->
 
5775
    ToOpt = fun(mandatory) ->
 
5776
                    'OPTIONAL';
 
5777
               (X) -> X
 
5778
            end,
 
5779
    {Root, [X#'ComponentType'{prop=ToOpt(Y)}||
 
5780
               X = #'ComponentType'{prop=Y}<-ExtList],[]};
 
5781
extension({Root1,ExtList,Root2}) ->
 
5782
    ToOpt = fun(mandatory) ->
 
5783
                    'OPTIONAL';
 
5784
               (X) -> X
 
5785
            end,
 
5786
    {Root1, [X#'ComponentType'{prop=ToOpt(Y)}||
 
5787
                X = #'ComponentType'{prop=Y}<-ExtList], Root2}.
 
5788
 
5134
5789
check_setof(S,Type,Component) when record(Component,type) ->
5135
5790
    check_type(S,Type,Component).
5136
5791
 
5176
5831
check_objectidentifier(_S,_Constr) ->
5177
5832
    ok.
5178
5833
 
 
5834
check_relative_oid(_S,_Constr) ->
 
5835
    ok.
5179
5836
% check all aspects of a CHOICE
5180
5837
% - that all alternative names are unique
5181
5838
% - that all TAGS are ok (when TAG default is applied)
5203
5860
check_choice(_S,_,[]) -> 
5204
5861
    [].
5205
5862
 
5206
 
maybe_automatic_tags(#state{erule=per},C) ->
5207
 
    C;
5208
 
maybe_automatic_tags(#state{erule=per_bin},C) ->
5209
 
    C;
5210
5863
maybe_automatic_tags(S,C) ->
5211
5864
    TagNos = tag_nums(C),
5212
5865
    case (S#state.module)#module.tagdefault of
5338
5991
        case Ts#type.def of
5339
5992
            #'Externaltypereference'{} -> [];
5340
5993
            _ -> [Cname|Path]
5341
 
        end,%%XXX Cname = toBeSigned
 
5994
        end,%%XXX Cname = 'per-message-indicators'
5342
5995
    CheckedTs = check_type(S#state{abscomppath=NewAbsCPath,
5343
5996
                                   recordtopname=[Cname|TopName]},Type,Ts),
5344
5997
    NewTags = get_taglist(S,CheckedTs),
5469
6122
                    [{ObjSet,Attr,N,ClassDef,_Path,ValueIndex}|_NewRest] ->
5470
6123
                        OS = object_set_mod_name(S,ObjSet),
5471
6124
                        UniqueFieldName = 
5472
 
                            case (catch get_unique_fieldname(#classdef{typespec=ClassDef})) of
5473
 
                                {error,'__undefined_'} ->
 
6125
                            case (catch get_unique_fieldname(S,#classdef{typespec=ClassDef})) of
 
6126
                                {error,'__undefined_',_} ->
5474
6127
                                    no_unique;
5475
6128
                                {asn1,Msg,_} ->
5476
6129
                                    error({type,Msg,S});
5477
 
                                Other -> Other
 
6130
                                {'EXIT',Msg} ->
 
6131
                                    error({type,{internal_error,Msg},S});
 
6132
                                {Other,_} -> Other
5478
6133
                            end,
5479
6134
%                       UsedFieldName = get_used_fieldname(S,Attr,STList),
5480
6135
                        %% Res should be done differently: even though
5502
6157
    ObjSet;
5503
6158
object_set_mod_name(#state{mname=M},
5504
6159
                    #'Externaltypereference'{module=M,type=T}) ->
5505
 
    T;
 
6160
    {M,T};
5506
6161
object_set_mod_name(S,#'Externaltypereference'{module=M,type=T}) ->
5507
6162
    case lists:member(M,S#state.inputmodules) of
5508
6163
        true -> 
5603
6258
            _ -> #classdef{typespec=ObjectClass}
5604
6259
        end,
5605
6260
    UniqueName =
5606
 
        case (catch get_unique_fieldname(ClassDef)) of
5607
 
            {error,'__undefined_'} -> no_unique;
 
6261
        case (catch get_unique_fieldname(S,ClassDef)) of
 
6262
            {error,'__undefined_',_} -> no_unique;
5608
6263
            {asn1,Msg,_} ->
5609
6264
                error({type,Msg,S});
5610
 
            Other -> Other
 
6265
            {'EXIT',Msg} ->
 
6266
                error({type,{internal_error,Msg},S});
 
6267
            {Other,_} -> Other
5611
6268
        end,
5612
6269
    {lists:reverse(Path),ObjectClassFieldName,UniqueName};
5613
6270
simple_table_info(S,Type,_) ->
5727
6384
        {_,[H|_T]} ->
5728
6385
            case lists:member(H,Cnames) of
5729
6386
                true -> [AtPathBelowTop];
5730
 
                _ -> error({type,{asn1,"failed to analyze at-path",AtPath},S})
 
6387
                _ -> 
 
6388
                 %% error({type,{asn1,"failed to analyze at-path",AtPath},S})
 
6389
                    throw({type,{asn1,"failed to analyze at-path",AtPath},S})
5731
6390
            end
5732
6391
    end;
5733
6392
evaluate_atpath(_,_,_,_) ->
5984
6643
    error({type,{asn1,"component of at-list was not"
5985
6644
                 " found in substructure",Name},S}).
5986
6645
 
5987
 
get_unique_fieldname(ClassDef) when record(ClassDef,classdef) ->
 
6646
get_unique_fieldname(_S,ClassDef) when is_record(ClassDef,classdef) ->
5988
6647
%%    {_,Fields,_} = ClassDef#classdef.typespec,
5989
6648
    Fields = (ClassDef#classdef.typespec)#objectclass.fields,
5990
 
    get_unique_fieldname(Fields,[]).
 
6649
    get_unique_fieldname1(Fields,[]);
 
6650
get_unique_fieldname(S,#typedef{typespec=#type{def=ClassRef}}) ->
 
6651
    %% A class definition may be referenced as
 
6652
    %% REFED-CLASS ::= DEFINED-CLASS and then REFED-CLASS is a typedef
 
6653
    {_M,ClassDef} = get_referenced_type(S,ClassRef),
 
6654
    get_unique_fieldname(S,ClassDef).
5991
6655
 
5992
 
get_unique_fieldname([],[]) ->
5993
 
    throw({error,'__undefined_'});
5994
 
get_unique_fieldname([],[Name]) ->
 
6656
get_unique_fieldname1([],[]) ->
 
6657
    throw({error,'__undefined_',[]});
 
6658
get_unique_fieldname1([],[Name]) ->
5995
6659
    Name;
5996
 
get_unique_fieldname([],Acc) ->
 
6660
get_unique_fieldname1([],Acc) ->
5997
6661
    throw({asn1,'only one UNIQUE field is allowed in CLASS',Acc});
5998
 
get_unique_fieldname([{fixedtypevaluefield,Name,_,'UNIQUE',_}|Rest],Acc) ->
5999
 
    get_unique_fieldname(Rest,[Name|Acc]);
6000
 
get_unique_fieldname([_H|T],Acc) ->
6001
 
    get_unique_fieldname(T,Acc).
 
6662
get_unique_fieldname1([{fixedtypevaluefield,Name,_,'UNIQUE',Opt}|Rest],Acc) ->
 
6663
    get_unique_fieldname1(Rest,[{Name,Opt}|Acc]);
 
6664
get_unique_fieldname1([_H|T],Acc) ->
 
6665
    get_unique_fieldname1(T,Acc).
6002
6666
 
6003
6667
get_tableconstraint_info(S,Type,{CheckedTs,EComps,CheckedTs2}) ->
6004
6668
    {get_tableconstraint_info(S,Type,CheckedTs,[]),
6055
6719
    {FirstFieldname,[]};
6056
6720
get_referenced_fieldname([{_,FirstFieldname}|Rest]) ->
6057
6721
    {FirstFieldname,lists:map(fun(X)->element(2,X) end,Rest)};
 
6722
get_referenced_fieldname(Def={FieldName,RestFieldName}) when is_atom(FieldName),is_list(RestFieldName)->
 
6723
    Def;
6058
6724
get_referenced_fieldname(Def) ->
6059
6725
    {no_type,Def}.
6060
6726
 
6070
6736
    get_ObjectClassFieldType(S,Fields,PrimFieldNameList);
6071
6737
get_ObjectClassFieldType(S,Fields,L=[_PrimFieldName1|_Rest]) ->
6072
6738
    check_PrimitiveFieldNames(S,Fields,L),
6073
 
    get_OCFType(S,Fields,L).
 
6739
    get_OCFType(S,Fields,L);
 
6740
get_ObjectClassFieldType(S,ERef,{FieldName,Rest}) ->
 
6741
    get_ObjectClassFieldType(S,ERef,Rest ++ [FieldName]).
6074
6742
 
6075
6743
check_PrimitiveFieldNames(_S,_Fields,_) ->
6076
6744
    ok.
6086
6754
get_ObjectClassFieldType_classdef(_,#'ObjectClassFieldType'{class=Cl}) ->
6087
6755
    Cl.
6088
6756
 
6089
 
get_OCFType(S,Fields,[{_FieldType,PrimFieldName}|Rest]) ->
 
6757
get_OCFType(S,Fields,FieldnameList=[{_FieldType,_PrimFieldName}|_]) ->
 
6758
    get_OCFType(S,Fields,[PFN||{_,PFN} <- FieldnameList]);
 
6759
get_OCFType(S,Fields,[PrimFieldName|Rest]) ->
6090
6760
    case lists:keysearch(PrimFieldName,2,Fields) of
6091
6761
        {value,{fixedtypevaluefield,_,Type,_Unique,_OptSpec}} ->
6092
6762
            {fixedtypevaluefield,PrimFieldName,Type};
6093
 
        {value,{objectfield,_,Type,_Unique,_OptSpec}} ->
6094
 
            {MName,ClassDef} = get_referenced_type(S,Type#type.def),
 
6763
        {value,{objectfield,_,ClassRef,_Unique,_OptSpec}} ->
 
6764
            {MName,ClassDef} = get_referenced_type(S,ClassRef),
6095
6765
            NewS = update_state(S#state{type=ClassDef,
6096
6766
                                        tname=get_datastr_name(ClassDef)},
6097
6767
                                MName),
6111
6781
            throw({error,lists:flatten(io_lib:format("undefined FieldName in ObjectClassFieldType: ~w",[PrimFieldName]))})
6112
6782
    end.
6113
6783
 
6114
 
get_taglist(#state{erule=per},_) ->
6115
 
    [];
6116
 
get_taglist(#state{erule=per_bin},_) ->
6117
 
    [];
6118
6784
get_taglist(S,Ext) when record(Ext,'Externaltypereference') ->
6119
6785
    {_,T} = get_referenced_type(S,Ext),
6120
6786
    get_taglist(S,T#typedef.typespec);
6140
6806
get_taglist(S,{ERef=#'Externaltypereference'{},FieldNameList})
6141
6807
  when list(FieldNameList) ->
6142
6808
    case get_ObjectClassFieldType(S,ERef,FieldNameList) of
6143
 
%       Type when record(Type,type) ->
6144
 
%           get_taglist(S,Type);
6145
6809
        {fixedtypevaluefield,_,Type} -> get_taglist(S,Type);
6146
6810
        {TypeFieldName,_} when atom(TypeFieldName) -> []%should check if allowed
6147
6811
    end;
6148
6812
get_taglist(S,{ObjCl,FieldNameList}) when record(ObjCl,objectclass),
6149
6813
                                          list(FieldNameList) ->
6150
6814
    case get_ObjectClassFieldType(S,ObjCl#objectclass.fields,FieldNameList) of
6151
 
%       Type when record(Type,type) ->
6152
 
%           get_taglist(S,Type);
6153
6815
        {fixedtypevaluefield,_,Type} -> get_taglist(S,Type);
6154
6816
        {TypeFieldName,_} when atom(TypeFieldName) -> []%should check if allowed
6155
6817
    end;
6244
6906
merge_tags2([], Acc) ->
6245
6907
    lists:reverse(Acc).
6246
6908
 
6247
 
merge_constraints(C1, []) ->
6248
 
    C1;
6249
 
merge_constraints([], C2) ->
6250
 
    C2;
6251
 
merge_constraints(C1, C2) ->
6252
 
    {SList,VList,PAList,Rest} = splitlist(C1++C2,[],[],[],[]),
6253
 
    SizeC = merge_constraints(SList),
6254
 
    ValueC = merge_constraints(VList),
6255
 
    PermAlphaC = merge_constraints(PAList),
6256
 
    case Rest of
6257
 
        [] ->
6258
 
            SizeC ++ ValueC ++ PermAlphaC;
6259
 
        _ ->
6260
 
            throw({error,{asn1,{not_implemented,{merge_constraints,Rest}}}})
6261
 
    end.
 
6909
%% merge_constraints(C1, []) ->
 
6910
%%     C1;
 
6911
%% merge_constraints([], C2) ->
 
6912
%%     C2;
 
6913
%% merge_constraints(C1, C2) ->
 
6914
%%     {SList,VList,PAList,Rest} = splitlist(C1++C2,[],[],[],[]),
 
6915
%%     SizeC = merge_constraints(SList),
 
6916
%%     ValueC = merge_constraints(VList),
 
6917
%%     PermAlphaC = merge_constraints(PAList),
 
6918
%%     case Rest of
 
6919
%%         [] ->
 
6920
%%             SizeC ++ ValueC ++ PermAlphaC;
 
6921
%%         _ ->
 
6922
%%             throw({error,{asn1,{not_implemented,{merge_constraints,Rest}}}})
 
6923
%%     end.
6262
6924
    
6263
 
merge_constraints([]) -> [];
6264
 
merge_constraints([C1 = {_,{Low1,High1}},{_,{Low2,High2}}|Rest]) when Low1 >= Low2,
6265
 
                                                                      High1 =< High2 ->
6266
 
    merge_constraints([C1|Rest]);
6267
 
merge_constraints([C1={'PermittedAlphabet',_},C2|Rest]) ->
6268
 
    [C1|merge_constraints([C2|Rest])];
6269
 
merge_constraints([C1 = {_,{_Low1,_High1}},C2 = {_,{_Low2,_High2}}|_Rest]) ->
6270
 
    throw({error,asn1,{conflicting_constraints,{C1,C2}}});
6271
 
merge_constraints([C]) ->
6272
 
    [C].
 
6925
%% merge_constraints([]) -> [];
 
6926
%% merge_constraints([C1 = {_,{Low1,High1}},{_,{Low2,High2}}|Rest]) when Low1 >= Low2,
 
6927
%%                                                                       High1 =< High2 ->
 
6928
%%     merge_constraints([C1|Rest]);
 
6929
%% merge_constraints([C1={'PermittedAlphabet',_},C2|Rest]) ->
 
6930
%%     [C1|merge_constraints([C2|Rest])];
 
6931
%% merge_constraints([C1 = {_,{_Low1,_High1}},C2 = {_,{_Low2,_High2}}|_Rest]) ->
 
6932
%%     throw({error,asn1,{conflicting_constraints,{C1,C2}}});
 
6933
%% merge_constraints([C]) ->
 
6934
%%     [C].
6273
6935
 
6274
 
splitlist([C={'SizeConstraint',_}|Rest],Sacc,Vacc,PAacc,Restacc) ->
6275
 
    splitlist(Rest,[C|Sacc],Vacc,PAacc,Restacc);
6276
 
splitlist([C={'ValueRange',_}|Rest],Sacc,Vacc,PAacc,Restacc) ->
6277
 
    splitlist(Rest,Sacc,[C|Vacc],PAacc,Restacc);
6278
 
splitlist([C={'PermittedAlphabet',_}|Rest],Sacc,Vacc,PAacc,Restacc) ->
6279
 
    splitlist(Rest,Sacc,Vacc,[C|PAacc],Restacc);
6280
 
splitlist([C|Rest],Sacc,Vacc,PAacc,Restacc) ->
6281
 
    splitlist(Rest,Sacc,Vacc,PAacc,[C|Restacc]);
6282
 
splitlist([],Sacc,Vacc,PAacc,Restacc) ->
6283
 
    {lists:reverse(Sacc),
6284
 
     lists:reverse(Vacc),
6285
 
     lists:reverse(PAacc),
6286
 
     lists:reverse(Restacc)}.
 
6936
%% splitlist([C={'SizeConstraint',_}|Rest],Sacc,Vacc,PAacc,Restacc) ->
 
6937
%%     splitlist(Rest,[C|Sacc],Vacc,PAacc,Restacc);
 
6938
%% splitlist([C={'ValueRange',_}|Rest],Sacc,Vacc,PAacc,Restacc) ->
 
6939
%%     splitlist(Rest,Sacc,[C|Vacc],PAacc,Restacc);
 
6940
%% splitlist([C={'PermittedAlphabet',_}|Rest],Sacc,Vacc,PAacc,Restacc) ->
 
6941
%%     splitlist(Rest,Sacc,Vacc,[C|PAacc],Restacc);
 
6942
%% splitlist([C|Rest],Sacc,Vacc,PAacc,Restacc) ->
 
6943
%%     splitlist(Rest,Sacc,Vacc,PAacc,[C|Restacc]);
 
6944
%% splitlist([],Sacc,Vacc,PAacc,Restacc) ->
 
6945
%%     {lists:reverse(Sacc),
 
6946
%%      lists:reverse(Vacc),
 
6947
%%      lists:reverse(PAacc),
 
6948
%%      lists:reverse(Restacc)}.
6287
6949
 
6288
6950
 
6289
6951
 
6503
7165
    Direct_reference = 
6504
7166
        #'ComponentType'{name='direct-reference',
6505
7167
                         typespec=#type{def='OBJECT IDENTIFIER'},
6506
 
                         prop='OPTIONAL'},
 
7168
                         prop='OPTIONAL',
 
7169
                         tags=[{'UNIVERSAL',6}]},
6507
7170
 
6508
7171
    Indirect_reference = 
6509
7172
        #'ComponentType'{name='indirect-reference',
6510
7173
                         typespec=#type{def='INTEGER'},
6511
 
                         prop='OPTIONAL'},
 
7174
                         prop='OPTIONAL',
 
7175
                         tags=[{'UNIVERSAL',2}]},
6512
7176
 
6513
7177
    Single_ASN1_type =
6514
7178
        #'ComponentType'{name='single-ASN1-type',
6515
7179
                         typespec=#type{tag=[{tag,'CONTEXT',0,
6516
7180
                                              'EXPLICIT',32}],
6517
7181
                                        def='ANY'},
6518
 
                         prop=mandatory},
 
7182
                         prop=mandatory,
 
7183
                         tags=[{'CONTEXT',0}]},
6519
7184
 
6520
7185
    Octet_aligned =
6521
7186
        #'ComponentType'{name='octet-aligned',
6522
7187
                         typespec=#type{tag=[{tag,'CONTEXT',1,
6523
7188
                                              'IMPLICIT',0}],
6524
7189
                                        def='OCTET STRING'},
6525
 
                         prop=mandatory},
 
7190
                         prop=mandatory,
 
7191
                         tags=[{'CONTEXT',1}]},
6526
7192
 
6527
7193
    Arbitrary =
6528
7194
        #'ComponentType'{name=arbitrary,
6529
7195
                         typespec=#type{tag=[{tag,'CONTEXT',2,
6530
7196
                                              'IMPLICIT',0}],
6531
7197
                                        def={'BIT STRING',[]}},
6532
 
                         prop=mandatory},
 
7198
                         prop=mandatory,
 
7199
                         tags=[{'CONTEXT',2}]},
6533
7200
 
6534
7201
    Encoding =
6535
7202
        #'ComponentType'{name=encoding,
6672
7339
        _ ->
6673
7340
            ""
6674
7341
    end.
 
7342
 
 
7343
insert_once(S,Tab,Key) ->
 
7344
    case get(top_module) of
 
7345
        M when M == S#state.mname ->
 
7346
            asn1ct_gen:insert_once(Tab,Key),
 
7347
            ok;
 
7348
        _ ->
 
7349
            skipped
 
7350
    end.