1%% ``Licensed under the Apache License, Version 2.0 (the "License");
2%% you may not use this file except in compliance with the License.
3%% You may obtain a copy of the License at
4%%
5%%     http://www.apache.org/licenses/LICENSE-2.0
6%%
7%% Unless required by applicable law or agreed to in writing, software
8%% distributed under the License is distributed on an "AS IS" BASIS,
9%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
10%% See the License for the specific language governing permissions and
11%% limitations under the License.
12%%
13%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
14%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
15%% AB. All Rights Reserved.''
16%%
17%%     $Id: asn1ct_check.erl,v 1.1 2008/12/17 09:53:29 mikpe Exp $
18-module(asn1ct_check).
19
20%% Main Module for ASN.1 compile time functions
21
22%-compile(export_all).
23-export([check/2,storeindb/1]).
24-include("asn1_records.hrl").
25%%% The tag-number for universal types
26-define(N_BOOLEAN, 1).
27-define(N_INTEGER, 2).
28-define(N_BIT_STRING, 3).
29-define(N_OCTET_STRING, 4).
30-define(N_NULL, 5).
31-define(N_OBJECT_IDENTIFIER, 6).
32-define(N_OBJECT_DESCRIPTOR, 7).
33-define(N_EXTERNAL, 8). % constructed
34-define(N_INSTANCE_OF,8).
35-define(N_REAL, 9).
36-define(N_ENUMERATED, 10).
37-define(N_EMBEDDED_PDV, 11). % constructed
38-define(N_SEQUENCE, 16).
39-define(N_SET, 17).
40-define(N_NumericString, 18).
41-define(N_PrintableString, 19).
42-define(N_TeletexString, 20).
43-define(N_VideotexString, 21).
44-define(N_IA5String, 22).
45-define(N_UTCTime, 23).
46-define(N_GeneralizedTime, 24).
47-define(N_GraphicString, 25).
48-define(N_VisibleString, 26).
49-define(N_GeneralString, 27).
50-define(N_UniversalString, 28).
51-define(N_CHARACTER_STRING, 29). % constructed
52-define(N_BMPString, 30).
53
54-define(TAG_PRIMITIVE(Num),
55	case S#state.erule of
56	    ber_bin_v2 ->
57		#tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=0};
58	    _ -> []
59	end).
60-define(TAG_CONSTRUCTED(Num),
61	case S#state.erule of
62	    ber_bin_v2 ->
63		#tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=32};
64	    _ -> []
65	end).
66
67-record(newt,{type=unchanged,tag=unchanged,constraint=unchanged,inlined=no}). % used in check_type to update type and tag
68-record(newv,{type=unchanged,value=unchanged}). % used in check_value to update type and value
69
70check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) ->
71    %%Predicates used to filter errors
72    TupleIs = fun({T,_},T) -> true;
73		 (_,_) -> false
74	      end,
75    IsClass = fun(X) -> TupleIs(X,asn1_class) end,
76    IsObjSet = fun(X) -> TupleIs(X,objectsetdef) end,
77    IsPObjSet = fun(X) -> TupleIs(X,pobjectsetdef) end,
78    IsObject = fun(X) -> TupleIs(X,objectdef) end,
79    IsValueSet = fun(X) -> TupleIs(X,valueset) end,
80    Element2 = fun(X) -> element(2,X) end,
81
82    _Perror = checkp(S,ParameterizedTypes,[]), % must do this before the templates are used
83    Terror = checkt(S,Types,[]),
84
85    %% get parameterized object sets sent to checkt/3
86    %% and update Terror
87
88    {PObjSetNames1,Terror2} = filter_errors(IsPObjSet,Terror),
89
90    Verror = checkv(S,Values ++ ObjectSets,[]), %value sets may be parsed as object sets
91
92     %% get information object classes wrongly sent to checkt/3
93     %% and update Terror2
94
95    {AddClasses,Terror3} = filter_errors(IsClass,Terror2),
96
97    NewClasses = Classes++AddClasses,
98
99    Cerror = checkc(S,NewClasses,[]),
100
101     %% get object sets incorrectly sent to checkv/3
102     %% and update Verror
103
104    {ObjSetNames,Verror2} = filter_errors(IsObjSet,Verror),
105
106     %% get parameterized object sets incorrectly sent to checkv/3
107     %% and update Verror2
108
109    {PObjSetNames,Verror3} = filter_errors(IsPObjSet,Verror2),
110
111     %% get objects incorrectly sent to checkv/3
112     %% and update Verror3
113
114    {ObjectNames,Verror4} = filter_errors(IsObject,Verror3),
115
116    NewObjects = Objects++ObjectNames,
117    NewObjectSets = ObjSetNames ++ PObjSetNames ++ PObjSetNames1,
118
119     %% get value sets
120     %% and update Verror4
121
122    {ValueSetNames,Verror5} = filter_errors(IsValueSet,Verror4),
123
124    asn1ct:create_ets_table(inlined_objects,[named_table]),
125    {Oerror,ExclO,ExclOS} = checko(S,NewObjects ++
126				   NewObjectSets,
127				   [],[],[]),
128    InlinedObjTuples = ets:tab2list(inlined_objects),
129    InlinedObjects = lists:map(Element2,InlinedObjTuples),
130    ets:delete(inlined_objects),
131
132    Exporterror = check_exports(S,S#state.module),
133    case {Terror3,Verror5,Cerror,Oerror,Exporterror} of
134	{[],[],[],[],[]} ->
135	    ContextSwitchTs = context_switch_in_spec(),
136	    InstanceOf = instance_of_in_spec(),
137	    NewTypes = lists:subtract(Types,AddClasses) ++ ContextSwitchTs
138		++ InstanceOf,
139	    NewValues = lists:subtract(Values,PObjSetNames++ObjectNames++
140				       ValueSetNames),
141	    {ok,
142	     {NewTypes,NewValues,ParameterizedTypes,
143	      NewClasses,NewObjects,NewObjectSets},
144	     {NewTypes,NewValues,ParameterizedTypes,NewClasses,
145	      lists:subtract(NewObjects,ExclO)++InlinedObjects,
146	      lists:subtract(NewObjectSets,ExclOS)}};
147	_ ->{error,{asn1,lists:flatten([Terror3,Verror5,Cerror,
148					Oerror,Exporterror])}}
149    end.
150
151context_switch_in_spec() ->
152    L = [{external,'EXTERNAL'},
153	 {embedded_pdv,'EMBEDDED PDV'},
154	 {character_string,'CHARACTER STRING'}],
155    F = fun({T,TName},Acc) ->
156		case get(T) of
157		    generate -> erase(T),
158				[TName|Acc];
159		    _ -> Acc
160		end
161	end,
162    lists:foldl(F,[],L).
163
164instance_of_in_spec() ->
165    case get(instance_of) of
166	generate ->
167	    erase(instance_of),
168	    ['INSTANCE OF'];
169	_ ->
170	    []
171    end.
172
173filter_errors(Pred,ErrorList) ->
174    Element2 = fun(X) -> element(2,X) end,
175    RemovedTupleElements = lists:filter(Pred,ErrorList),
176    RemovedNames = lists:map(Element2,RemovedTupleElements),
177    %% remove value set name tuples from Verror
178    RestErrors = lists:subtract(ErrorList,RemovedTupleElements),
179    {RemovedNames,RestErrors}.
180
181
182check_exports(S,Module = #module{}) ->
183    case Module#module.exports of
184	{exports,[]} ->
185	    [];
186	{exports,all} ->
187	    [];
188	{exports,ExportList} when list(ExportList) ->
189	    IsNotDefined =
190		fun(X) ->
191			case catch get_referenced_type(S,X) of
192			    {error,{asn1,_}} ->
193				true;
194			    _ -> false
195			end
196		end,
197	    case lists:filter(IsNotDefined,ExportList) of
198		[] ->
199		    [];
200		NoDefExp ->
201		    GetName =
202			fun(T = #'Externaltypereference'{type=N})->
203				%%{exported,undefined,entity,N}
204				NewS=S#state{type=T,tname=N},
205				error({export,"exported undefined entity",NewS})
206			end,
207		    lists:map(GetName,NoDefExp)
208	    end
209    end.
210
211checkt(S,[Name|T],Acc) ->
212    %%io:format("check_typedef:~p~n",[Name]),
213    Result =
214	case asn1_db:dbget(S#state.mname,Name) of
215	    undefined ->
216		error({type,{internal_error,'???'},S});
217	    Type when record(Type,typedef) ->
218		NewS = S#state{type=Type,tname=Name},
219		case catch(check_type(NewS,Type,Type#typedef.typespec)) of
220		    {error,Reason} ->
221			error({type,Reason,NewS});
222		    {'EXIT',Reason} ->
223			error({type,{internal_error,Reason},NewS});
224		    {asn1_class,_ClassDef} ->
225			{asn1_class,Name};
226		    pobjectsetdef ->
227			{pobjectsetdef,Name};
228		    pvalueset ->
229			{pvalueset,Name};
230		    Ts ->
231			case Type#typedef.checked of
232			    true -> % already checked and updated
233				ok;
234			    _ ->
235				NewTypeDef = Type#typedef{checked=true,typespec = Ts},
236				%io:format("checkt:dbput:~p, ~p~n",[S#state.mname,NewTypeDef#typedef.name]),
237				asn1_db:dbput(NewS#state.mname,Name,NewTypeDef), % update the type
238				ok
239			end
240		end
241	end,
242    case Result of
243	ok ->
244	    checkt(S,T,Acc);
245	_ ->
246	    checkt(S,T,[Result|Acc])
247    end;
248checkt(S,[],Acc) ->
249    case check_contextswitchingtypes(S,[]) of
250	[] ->
251	    lists:reverse(Acc);
252	L ->
253	    checkt(S,L,Acc)
254    end.
255
256check_contextswitchingtypes(S,Acc) ->
257    CSTList=[{external,'EXTERNAL'},
258	     {embedded_pdv,'EMBEDDED PDV'},
259	     {character_string,'CHARACTER STRING'}],
260    check_contextswitchingtypes(S,CSTList,Acc).
261
262check_contextswitchingtypes(S,[{T,TName}|Ts],Acc) ->
263     case get(T) of
264	unchecked ->
265	    put(T,generate),
266	    check_contextswitchingtypes(S,Ts,[TName|Acc]);
267	_ ->
268	    check_contextswitchingtypes(S,Ts,Acc)
269     end;
270check_contextswitchingtypes(_,[],Acc) ->
271    Acc.
272
273checkv(S,[Name|T],Acc) ->
274    %%io:format("check_valuedef:~p~n",[Name]),
275    Result = case asn1_db:dbget(S#state.mname,Name) of
276		 undefined -> error({value,{internal_error,'???'},S});
277		 Value when record(Value,valuedef);
278			    record(Value,typedef); %Value set may be parsed as object set.
279			    record(Value,pvaluedef);
280			    record(Value,pvaluesetdef) ->
281		     NewS = S#state{value=Value},
282		     case catch(check_value(NewS,Value)) of
283			 {error,Reason} ->
284			     error({value,Reason,NewS});
285			 {'EXIT',Reason} ->
286			     error({value,{internal_error,Reason},NewS});
287			 {pobjectsetdef} ->
288			     {pobjectsetdef,Name};
289			 {objectsetdef} ->
290			     {objectsetdef,Name};
291			 {objectdef} ->
292			     %% this is an object, save as typedef
293			     #valuedef{checked=C,pos=Pos,name=N,type=Type,
294				       value=Def}=Value,
295%			     Currmod = S#state.mname,
296%			     #type{def=
297%				   #'Externaltypereference'{module=Mod,
298%							    type=CName}} = Type,
299			     ClassName =
300				 Type#type.def,
301% 				 case Mod of
302% 				     Currmod ->
303% 					 {objectclassname,CName};
304% 				     _ ->
305% 					 {objectclassname,Mod,CName}
306% 				 end,
307			     NewSpec = #'Object'{classname=ClassName,
308						 def=Def},
309			     NewDef = #typedef{checked=C,pos=Pos,name=N,
310					       typespec=NewSpec},
311			     asn1_db:dbput(NewS#state.mname,Name,NewDef),
312			     {objectdef,Name};
313			 {valueset,VSet} ->
314			     Pos = asn1ct:get_pos_of_def(Value),
315			     CheckedVSDef = #typedef{checked=true,pos=Pos,
316						     name=Name,typespec=VSet},
317			     asn1_db:dbput(NewS#state.mname,Name,CheckedVSDef),
318			     {valueset,Name};
319			 V ->
320			     %% update the valuedef
321			     asn1_db:dbput(NewS#state.mname,Name,V),
322			     ok
323		     end
324	     end,
325    case Result of
326	ok ->
327	    checkv(S,T,Acc);
328	_ ->
329	    checkv(S,T,[Result|Acc])
330    end;
331checkv(_S,[],Acc) ->
332    lists:reverse(Acc).
333
334
335checkp(S,[Name|T],Acc) ->
336    %io:format("check_ptypedef:~p~n",[Name]),
337    Result = case asn1_db:dbget(S#state.mname,Name) of
338	undefined ->
339	    error({type,{internal_error,'???'},S});
340	Type when record(Type,ptypedef) ->
341	    NewS = S#state{type=Type,tname=Name},
342	    case catch(check_ptype(NewS,Type,Type#ptypedef.typespec)) of
343		{error,Reason} ->
344		    error({type,Reason,NewS});
345		{'EXIT',Reason} ->
346		    error({type,{internal_error,Reason},NewS});
347		{asn1_class,_ClassDef} ->
348		    {asn1_class,Name};
349		Ts ->
350		    NewType = Type#ptypedef{checked=true,typespec = Ts},
351		    asn1_db:dbput(NewS#state.mname,Name,NewType), % update the type
352		    ok
353	    end
354	     end,
355    case Result of
356	ok ->
357	    checkp(S,T,Acc);
358	_ ->
359	    checkp(S,T,[Result|Acc])
360    end;
361checkp(_S,[],Acc) ->
362    lists:reverse(Acc).
363
364
365
366
367checkc(S,[Name|Cs],Acc) ->
368    Result =
369	case asn1_db:dbget(S#state.mname,Name) of
370	    undefined ->
371		error({class,{internal_error,'???'},S});
372	    Class  ->
373		ClassSpec = if
374			       record(Class,classdef) ->
375				   Class#classdef.typespec;
376			       record(Class,typedef) ->
377				   Class#typedef.typespec
378			   end,
379		NewS = S#state{type=Class,tname=Name},
380		case catch(check_class(NewS,ClassSpec)) of
381		    {error,Reason} ->
382			error({class,Reason,NewS});
383		    {'EXIT',Reason} ->
384			error({class,{internal_error,Reason},NewS});
385		    C ->
386			%% update the classdef
387			NewClass =
388			    if
389				record(Class,classdef) ->
390				    Class#classdef{checked=true,typespec=C};
391				record(Class,typedef) ->
392				    #classdef{checked=true,name=Name,typespec=C}
393			    end,
394			asn1_db:dbput(NewS#state.mname,Name,NewClass),
395			ok
396		end
397	end,
398    case Result of
399	ok ->
400	    checkc(S,Cs,Acc);
401	_ ->
402	    checkc(S,Cs,[Result|Acc])
403    end;
404checkc(_S,[],Acc) ->
405%%    include_default_class(S#state.mname),
406    lists:reverse(Acc).
407
408checko(S,[Name|Os],Acc,ExclO,ExclOS) ->
409    Result =
410	case asn1_db:dbget(S#state.mname,Name) of
411	    undefined ->
412		error({type,{internal_error,'???'},S});
413	    Object when record(Object,typedef) ->
414		NewS = S#state{type=Object,tname=Name},
415		case catch(check_object(NewS,Object,Object#typedef.typespec)) of
416		    {error,Reason} ->
417			error({type,Reason,NewS});
418		    {'EXIT',Reason} ->
419			error({type,{internal_error,Reason},NewS});
420		    {asn1,Reason} ->
421			error({type,Reason,NewS});
422		    O ->
423			NewObj = Object#typedef{checked=true,typespec=O},
424			asn1_db:dbput(NewS#state.mname,Name,NewObj),
425			if
426			    record(O,'Object') ->
427				case O#'Object'.gen of
428				    true ->
429					{ok,ExclO,ExclOS};
430				    false ->
431					{ok,[Name|ExclO],ExclOS}
432				end;
433			    record(O,'ObjectSet') ->
434				case O#'ObjectSet'.gen of
435				    true ->
436					{ok,ExclO,ExclOS};
437				    false ->
438					{ok,ExclO,[Name|ExclOS]}
439				end
440			end
441		end;
442	    PObject when record(PObject,pobjectdef) ->
443		NewS = S#state{type=PObject,tname=Name},
444		case (catch check_pobject(NewS,PObject)) of
445		    {error,Reason} ->
446			error({type,Reason,NewS});
447		    {'EXIT',Reason} ->
448			error({type,{internal_error,Reason},NewS});
449		    {asn1,Reason} ->
450			error({type,Reason,NewS});
451		    PO ->
452			NewPObj = PObject#pobjectdef{def=PO},
453			asn1_db:dbput(NewS#state.mname,Name,NewPObj),
454			{ok,[Name|ExclO],ExclOS}
455		end;
456	    PObjSet when record(PObjSet,pvaluesetdef) ->
457		%% this is a parameterized object set. Might be a parameterized
458		%% value set, couldn't it?
459		NewS = S#state{type=PObjSet,tname=Name},
460		case (catch check_pobjectset(NewS,PObjSet)) of
461		    {error,Reason} ->
462			error({type,Reason,NewS});
463		    {'EXIT',Reason} ->
464			error({type,{internal_error,Reason},NewS});
465		    {asn1,Reason} ->
466			error({type,Reason,NewS});
467		    POS ->
468			%%NewPObjSet = PObjSet#pvaluesetdef{valueset=POS},
469			asn1_db:dbput(NewS#state.mname,Name,POS),
470			{ok,ExclO,[Name|ExclOS]}
471		end
472	end,
473    case Result of
474	{ok,NewExclO,NewExclOS} ->
475	    checko(S,Os,Acc,NewExclO,NewExclOS);
476	_ ->
477	    checko(S,Os,[Result|Acc],ExclO,ExclOS)
478    end;
479checko(_S,[],Acc,ExclO,ExclOS) ->
480    {lists:reverse(Acc),lists:reverse(ExclO),lists:reverse(ExclOS)}.
481
482check_class(S,CDef=#classdef{checked=Ch,name=Name,typespec=TS}) ->
483    case Ch of
484	true -> TS;
485	idle -> TS;
486	_ ->
487	    NewCDef = CDef#classdef{checked=idle},
488	    asn1_db:dbput(S#state.mname,Name,NewCDef),
489	    CheckedTS = check_class(S,TS),
490	    asn1_db:dbput(S#state.mname,Name,
491			  NewCDef#classdef{checked=true,
492					   typespec=CheckedTS}),
493	    CheckedTS
494    end;
495check_class(S = #state{mname=M,tname=T},ClassSpec)
496  when record(ClassSpec,type) ->
497    Def = ClassSpec#type.def,
498    case Def of
499	#'Externaltypereference'{module=M,type=T} ->
500	    #objectclass{fields=Def}; % in case of recursive definitions
501	Tref when record(Tref,'Externaltypereference') ->
502	    {_,RefType} = get_referenced_type(S,Tref),
503% 	    case RefType of
504% 		RefClass when record(RefClass,classdef) ->
505% 		    check_class(S,RefClass#classdef.typespec)
506% 	    end
507	    case is_class(S,RefType) of
508		true ->
509		    check_class(S,get_class_def(S,RefType));
510		_ ->
511		    error({class,{internal_error,RefType},S})
512	    end
513    end;
514% check_class(S,{objectclassname,ModuleName,ClassName}) when atom(ModuleName),atom(ClassName) ->
515%     'fix this';
516check_class(S,C) when record(C,objectclass) ->
517    NewFieldSpec = check_class_fields(S,C#objectclass.fields),
518    C#objectclass{fields=NewFieldSpec};
519%check_class(S,{objectclassname,ClassName}) ->
520check_class(S,ClassName) ->
521    {_,Def} = get_referenced_type(S,ClassName),
522    case Def of
523	ClassDef when record(ClassDef,classdef) ->
524	    case ClassDef#classdef.checked of
525		true ->
526		    ClassDef#classdef.typespec;
527		idle ->
528		    ClassDef#classdef.typespec;
529		false ->
530		    check_class(S,ClassDef#classdef.typespec)
531	    end;
532	TypeDef when record(TypeDef,typedef) ->
533	    %% this case may occur when a definition is a reference
534	    %% to a class definition.
535	    case TypeDef#typedef.typespec of
536		#type{def=Ext} when record(Ext,'Externaltypereference') ->
537		    check_class(S,Ext)
538	    end
539    end;
540check_class(_S,{poc,_ObjSet,_Params}) ->
541    'fix this later'.
542
543check_class_fields(S,Fields) ->
544    check_class_fields(S,Fields,[]).
545
546check_class_fields(S,[F|Fields],Acc) ->
547    NewField =
548	case element(1,F) of
549	    fixedtypevaluefield ->
550		{_,Name,Type,Unique,OSpec} = F,
551		RefType = check_type(S,#typedef{typespec=Type},Type),
552		{fixedtypevaluefield,Name,RefType,Unique,OSpec};
553	    object_or_fixedtypevalue_field ->
554		{_,Name,Type,Unique,OSpec} = F,
555		Cat =
556		    case asn1ct_gen:type(asn1ct_gen:get_inner(Type#type.def)) of
557			Def when record(Def,typereference);
558				 record(Def,'Externaltypereference') ->
559			    {_,D} = get_referenced_type(S,Def),
560			    D;
561			{undefined,user} ->
562			    %% neither of {primitive,bif} or {constructed,bif}
563%%			    {_,D} = get_referenced_type(S,#typereference{val=Type#type.def}),
564			    {_,D} = get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=Type#type.def}),
565			    D;
566			_ ->
567			    Type
568		    end,
569		case Cat of
570		    Class when record(Class,classdef) ->
571			{objectfield,Name,Type,Unique,OSpec};
572		    _ ->
573			RefType = check_type(S,#typedef{typespec=Type},Type),
574			{fixedtypevaluefield,Name,RefType,Unique,OSpec}
575		end;
576	    objectset_or_fixedtypevalueset_field ->
577		{_,Name,Type,OSpec} = F,
578%%		RefType = check_type(S,#typedef{typespec=Type},Type),
579		RefType =
580		    case (catch check_type(S,#typedef{typespec=Type},Type)) of
581			{asn1_class,_ClassDef} ->
582			    case if_current_checked_type(S,Type) of
583				true ->
584				    Type#type.def;
585				_ ->
586				    check_class(S,Type)
587			    end;
588			CheckedType when record(CheckedType,type) ->
589			    CheckedType;
590			_ ->
591			    error({class,"internal error, check_class_fields",S})
592		    end,
593		if
594		    record(RefType,'Externaltypereference') ->
595			{objectsetfield,Name,Type,OSpec};
596		    record(RefType,classdef) ->
597			{objectsetfield,Name,Type,OSpec};
598		    record(RefType,objectclass) ->
599			{objectsetfield,Name,Type,OSpec};
600		    true ->
601			{fixedtypevaluesetfield,Name,RefType,OSpec}
602		end;
603	    typefield ->
604		case F of
605		    {TF,Name,{'DEFAULT',Type}} ->
606			{TF,Name,{'DEFAULT',check_type(S,#typedef{typespec=Type},Type)}};
607		    _ -> F
608		end;
609	    _ -> F
610	end,
611    check_class_fields(S,Fields,[NewField|Acc]);
612check_class_fields(_S,[],Acc) ->
613    lists:reverse(Acc).
614
615if_current_checked_type(S,#type{def=Def}) ->
616    CurrentCheckedName = S#state.tname,
617    MergedModules = S#state.inputmodules,
618 %   CurrentCheckedModule = S#state.mname,
619    case Def of
620	#'Externaltypereference'{module=CurrentCheckedName,
621				 type=CurrentCheckedName} ->
622	    true;
623	#'Externaltypereference'{module=ModuleName,
624				 type=CurrentCheckedName} ->
625	    case MergedModules of
626		undefined ->
627		    false;
628		_ ->
629		    lists:member(ModuleName,MergedModules)
630	    end;
631	_ ->
632	    false
633    end.
634
635
636
637check_pobject(_S,PObject) when record(PObject,pobjectdef) ->
638    Def = PObject#pobjectdef.def,
639    Def.
640
641
642check_pobjectset(S,PObjSet) ->
643    #pvaluesetdef{pos=Pos,name=Name,args=Args,type=Type,
644		  valueset=ValueSet}=PObjSet,
645    {Mod,Def} = get_referenced_type(S,Type#type.def),
646    case Def of
647	#classdef{} ->
648	    ClassName = #'Externaltypereference'{module=Mod,
649						 type=Def#classdef.name},
650	    {valueset,Set} = ValueSet,
651%	    ObjectSet = #'ObjectSet'{class={objectclassname,ClassName},
652	    ObjectSet = #'ObjectSet'{class=ClassName,
653				     set=Set},
654	    #pobjectsetdef{pos=Pos,name=Name,args=Args,class=Type#type.def,
655			   def=ObjectSet};
656	_ ->
657	    PObjSet
658    end.
659
660check_object(_S,ObjDef,ObjSpec) when (ObjDef#typedef.checked == true) ->
661    ObjSpec;
662check_object(S,_ObjDef,#'Object'{classname=ClassRef,def=ObjectDef}) ->
663    {_,_ClassDef} = get_referenced_type(S,ClassRef),
664    NewClassRef = check_externaltypereference(S,ClassRef),
665    ClassDef =
666	case _ClassDef#classdef.checked of
667	    false ->
668		#classdef{checked=true,
669			  typespec=check_class(S,_ClassDef#classdef.typespec)};
670	    _ ->
671		_ClassDef
672	end,
673    NewObj =
674	case ObjectDef of
675	    Def when tuple(Def), (element(1,Def)==object) ->
676		NewSettingList = check_objectdefn(S,Def,ClassDef),
677		#'Object'{def=NewSettingList};
678%	    Def when tuple(Def), (element(1,Def)=='ObjectFromObject') ->
679%		fixa;
680	    {po,{object,DefObj},ArgsList} ->
681		{_,Object} = get_referenced_type(S,DefObj),%DefObj is a
682		%%#'Externalvaluereference' or a #'Externaltypereference'
683		%% Maybe this call should be catched and in case of an exception
684		%% an nonallocated parameterized object should be returned.
685		instantiate_po(S,ClassDef,Object,ArgsList);
686	    #'Externalvaluereference'{} ->
687		{_,Object} = get_referenced_type(S,ObjectDef),
688		check_object(S,Object,Object#typedef.typespec);
689	    _  ->
690		exit({error,{no_object,ObjectDef},S})
691	end,
692    Gen = gen_incl(S,NewObj#'Object'.def,
693		   (ClassDef#classdef.typespec)#objectclass.fields),
694    NewObj#'Object'{classname=NewClassRef,gen=Gen};
695
696%%check_object(S,ObjSetDef,ObjSet=#type{def={pt,ObjSetRef,Args}}) ->
697    %% A parameterized
698
699check_object(S,
700	     _ObjSetDef,
701	     ObjSet=#'ObjectSet'{class=ClassRef}) ->
702    {_,ClassDef} = get_referenced_type(S,ClassRef),
703    NewClassRef = check_externaltypereference(S,ClassRef),
704    UniqueFieldName =
705	case (catch get_unique_fieldname(ClassDef)) of
706	    {error,'__undefined_'} -> {unique,undefined};
707	    {asn1,Msg,_} -> error({class,Msg,S});
708	    Other -> Other
709	end,
710    NewObjSet=
711	case ObjSet#'ObjectSet'.set of
712	    {'SingleValue',Set} when list(Set) ->
713		CheckedSet = check_object_list(S,NewClassRef,Set),
714		NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName),
715		ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
716				   set=NewSet};
717	    {'SingleValue',{definedvalue,ObjName}} ->
718		{_,ObjDef} = get_referenced_type(S,#identifier{val=ObjName}),
719		#'Object'{def=CheckedObj} =
720		    check_object(S,ObjDef,ObjDef#typedef.typespec),
721		NewSet = get_unique_valuelist(S,[{ObjDef#typedef.name,
722						  CheckedObj}],
723					      UniqueFieldName),
724		ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
725				   set=NewSet};
726	    {'SingleValue',#'Externalvaluereference'{value=ObjName}} ->
727		{_,ObjDef} = get_referenced_type(S,#identifier{val=ObjName}),
728		#'Object'{def=CheckedObj} =
729		    check_object(S,ObjDef,ObjDef#typedef.typespec),
730		NewSet = get_unique_valuelist(S,[{ObjDef#typedef.name,
731						  CheckedObj}],
732					      UniqueFieldName),
733		ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
734				   set=NewSet};
735	    ['EXTENSIONMARK'] ->
736		ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
737				   set=['EXTENSIONMARK']};
738	    Set when list(Set) ->
739		CheckedSet = check_object_list(S,NewClassRef,Set),
740		NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName),
741		ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
742				   set=NewSet};
743	    {Set,Ext} when list(Set) ->
744		CheckedSet = check_object_list(S,NewClassRef,Set++Ext),
745		NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName),
746		ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
747				   set=NewSet++['EXTENSIONMARK']};
748	    {{'SingleValue',Set},Ext} ->
749		CheckedSet = check_object_list(S,NewClassRef,
750					       merge_sets(Set,Ext)),
751		NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName),
752		ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
753				   set=NewSet++['EXTENSIONMARK']};
754	    {Type,{'EXCEPT',Exclusion}} when record(Type,type) ->
755		{_,TDef} = get_referenced_type(S,Type#type.def),
756		OS = TDef#typedef.typespec,
757		NewSet = reduce_objectset(OS#'ObjectSet'.set,Exclusion),
758		NewOS = OS#'ObjectSet'{set=NewSet},
759		check_object(S,TDef#typedef{typespec=NewOS},
760			     NewOS);
761	    #type{def={pt,DefinedObjSet,ParamList}} ->
762		{_,PObjSetDef} = get_referenced_type(S,DefinedObjSet),
763		instantiate_pos(S,ClassDef,PObjSetDef,ParamList);
764	    {ObjDef={object,definedsyntax,_ObjFields},_Ext} ->
765		CheckedSet = check_object_list(S,NewClassRef,[ObjDef]),
766		NewSet = get_unique_valuelist(S,CheckedSet,UniqueFieldName),
767		ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
768				   set=NewSet++['EXTENSIONMARK']}
769	end,
770    Gen = gen_incl_set(S,NewObjSet#'ObjectSet'.set,
771		       ClassDef),
772    NewObjSet#'ObjectSet'{class=NewClassRef,gen=Gen}.
773
774
775merge_sets(Set,Ext) when list(Set),list(Ext) ->
776    Set ++ Ext;
777merge_sets(Set,Ext) when list(Ext) ->
778    [Set|Ext];
779merge_sets(Set,{'SingleValue',Ext}) when list(Set) ->
780    Set ++ [Ext];
781merge_sets(Set,{'SingleValue',Ext}) ->
782    [Set] ++ [Ext].
783
784reduce_objectset(ObjectSet,Exclusion) ->
785    case Exclusion of
786	{'SingleValue',#'Externalvaluereference'{value=Name}} ->
787	    case lists:keysearch(Name,1,ObjectSet) of
788		{value,El} ->
789		    lists:subtract(ObjectSet,[El]);
790		_ ->
791		    ObjectSet
792	    end
793    end.
794
795%% Checks a list of objects or object sets and returns a list of selected
796%% information for the code generation.
797check_object_list(S,ClassRef,ObjectList) ->
798    check_object_list(S,ClassRef,ObjectList,[]).
799
800check_object_list(S,ClassRef,[ObjOrSet|Objs],Acc) ->
801    case ObjOrSet of
802	ObjDef when tuple(ObjDef),(element(1,ObjDef)==object) ->
803	    Def =
804		check_object(S,#typedef{typespec=ObjDef},
805%			     #'Object'{classname={objectclassname,ClassRef},
806			     #'Object'{classname=ClassRef,
807				       def=ObjDef}),
808	    check_object_list(S,ClassRef,Objs,[{no_name,Def#'Object'.def}|Acc]);
809	{'SingleValue',{definedvalue,ObjName}} ->
810	    {_,ObjectDef} = get_referenced_type(S,#identifier{val=ObjName}),
811	    #'Object'{def=Def} = check_object(S,ObjectDef,ObjectDef#typedef.typespec),
812	    check_object_list(S,ClassRef,Objs,[{ObjectDef#typedef.name,Def}|Acc]);
813	{'SingleValue',Ref = #'Externalvaluereference'{}} ->
814	    {_,ObjectDef} = get_referenced_type(S,Ref),
815	    #'Object'{def=Def} = check_object(S,ObjectDef,ObjectDef#typedef.typespec),
816	    check_object_list(S,ClassRef,Objs,[{ObjectDef#typedef.name,Def}|Acc]);
817	ObjRef when record(ObjRef,'Externalvaluereference') ->
818	    {_,ObjectDef} = get_referenced_type(S,ObjRef),
819	    #'Object'{def=Def} = check_object(S,ObjectDef,ObjectDef#typedef.typespec),
820	    check_object_list(S,ClassRef,Objs,
821%%			      [{ObjRef#'Externalvaluereference'.value,Def}|Acc]);
822			      [{ObjectDef#typedef.name,Def}|Acc]);
823	{'ValueFromObject',{_,Object},FieldName} ->
824	    {_,Def} = get_referenced_type(S,Object),
825%%	    TypeOrVal = get_fieldname_element(S,Def,FieldName);%% this must result in an object set
826	    TypeDef = get_fieldname_element(S,Def,FieldName),
827	    (TypeDef#typedef.typespec)#'ObjectSet'.set;
828	ObjSet when record(ObjSet,type) ->
829	    ObjSetDef =
830		case ObjSet#type.def of
831		    Ref when record(Ref,typereference);
832			     record(Ref,'Externaltypereference') ->
833			{_,D} = get_referenced_type(S,ObjSet#type.def),
834			D;
835		    Other ->
836			throw({asn1_error,{'unknown objecset',Other,S}})
837		end,
838	    #'ObjectSet'{set=ObjectsInSet} =
839		check_object(S,ObjSetDef,ObjSetDef#typedef.typespec),
840	    AccList = transform_set_to_object_list(ObjectsInSet,[]),
841	    check_object_list(S,ClassRef,Objs,AccList++Acc);
842	union ->
843	    check_object_list(S,ClassRef,Objs,Acc);
844	Other ->
845	    exit({error,{'unknown object',Other},S})
846    end;
847%% Finally reverse the accumulated list and if there are any extension
848%% marks in the object set put one indicator of that in the end of the
849%% list.
850check_object_list(_,_,[],Acc) ->
851    lists:reverse(Acc).
852%%    case lists:member('EXTENSIONMARK',RevAcc) of
853%%	true ->
854%%	    ExclRevAcc = lists:filter(fun(X)->X /= 'EXTENSIONMARK' end,
855%%				      RevAcc),
856%%	    ExclRevAcc ++ ['EXTENSIONMARK'];
857%%	false ->
858%%	    RevAcc
859%%    end.
860
861
862%%  get_fieldname_element/3
863%%  gets the type/value/object/... of the referenced element in FieldName
864%%  FieldName is a list and may have more than one element.
865%%  Each element in FieldName can be either {typefieldreference,AnyFieldName}
866%%  or {valuefieldreference,AnyFieldName}
867%%  Def is the def of the first object referenced by FieldName
868get_fieldname_element(S,Def,[{_RefType,FieldName}]) when record(Def,typedef) ->
869    {_,_,ObjComps} = (Def#typedef.typespec)#'Object'.def,
870    case lists:keysearch(FieldName,1,ObjComps) of
871	{value,{_,TDef}} when record(TDef,typedef) ->
872	    %%    ORec = TDef#typedef.typespec, %% XXX This must be made general
873% 	    case TDef#typedef.typespec of
874% 		ObjSetRec when record(ObjSetRec,'ObjectSet') ->
875% 		    ObjSet = ObjSetRec#'ObjectSet'.set;
876% 		ObjRec when record(ObjRec,'Object') ->
877% 		    %% now get the field in ObjRec that RestFName points out
878% 		    %ObjRec
879% 		    TDef
880% 	    end;
881	    TDef;
882	{value,{_,VDef}} when record(VDef,valuedef) ->
883	    check_value(S,VDef);
884	_ ->
885	    throw({assigned_object_error,"not_assigned_object",S})
886    end;
887get_fieldname_element(_S,Def,[{_RefType,_FieldName}|_RestFName])
888  when record(Def,typedef) ->
889    ok.
890
891transform_set_to_object_list([{Name,_UVal,Fields}|Objs],Acc) ->
892    transform_set_to_object_list(Objs,[{Name,{object,generatesyntax,Fields}}|Acc]);
893transform_set_to_object_list(['EXTENSIONMARK'|Objs],Acc) ->
894%%    transform_set_to_object_list(Objs,['EXTENSIONMARK'|Acc]);
895    transform_set_to_object_list(Objs,Acc);
896transform_set_to_object_list([],Acc) ->
897    Acc.
898
899get_unique_valuelist(_S,ObjSet,{unique,undefined}) -> % no unique field in object
900    lists:map(fun({N,{_,_,F}})->{N,F};
901		 (V={_,_,_}) ->V end, ObjSet);
902get_unique_valuelist(S,ObjSet,UFN) ->
903    get_unique_vlist(S,ObjSet,UFN,[]).
904
905get_unique_vlist(S,[],_,Acc) ->
906    case catch check_uniqueness(Acc) of
907	{asn1_error,_} ->
908%	    exit({error,Reason,S});
909	    error({'ObjectSet',"not unique objects in object set",S});
910	true ->
911	    lists:reverse(Acc)
912    end;
913get_unique_vlist(S,[{ObjName,Obj}|Rest],UniqueFieldName,Acc) ->
914    {_,_,Fields} = Obj,
915    VDef = get_unique_value(S,Fields,UniqueFieldName),
916    get_unique_vlist(S,Rest,UniqueFieldName,
917		     [{ObjName,VDef#valuedef.value,Fields}|Acc]);
918get_unique_vlist(S,[V={_,_,_}|Rest],UniqueFieldName,Acc) ->
919    get_unique_vlist(S,Rest,UniqueFieldName,[V|Acc]).
920
921get_unique_value(S,Fields,UniqueFieldName) ->
922    Module = S#state.mname,
923    case lists:keysearch(UniqueFieldName,1,Fields) of
924	{value,Field} ->
925	    case element(2,Field) of
926		VDef when record(VDef,valuedef) ->
927		    VDef;
928		{definedvalue,ValName} ->
929		    ValueDef = asn1_db:dbget(Module,ValName),
930		    case ValueDef of
931			VDef when record(VDef,valuedef) ->
932			    ValueDef;
933			undefined ->
934			    #valuedef{value=ValName}
935		    end;
936		{'ValueFromObject',Object,Name} ->
937		    case Object of
938			{object,Ext} when record(Ext,'Externaltypereference') ->
939			    OtherModule = Ext#'Externaltypereference'.module,
940			    ExtObjName = Ext#'Externaltypereference'.type,
941			    ObjDef = asn1_db:dbget(OtherModule,ExtObjName),
942			    ObjSpec = ObjDef#typedef.typespec,
943			    get_unique_value(OtherModule,element(3,ObjSpec),Name);
944			{object,{_,_,ObjName}} ->
945			    ObjDef = asn1_db:dbget(Module,ObjName),
946			    ObjSpec = ObjDef#typedef.typespec,
947			    get_unique_value(Module,element(3,ObjSpec),Name);
948			{po,Object,_Params} ->
949			    exit({error,{'parameterized object not implemented yet',
950					 Object},S})
951		    end;
952		Value when atom(Value);number(Value) ->
953		    #valuedef{value=Value};
954		{'CHOICE',{_,Value}} when atom(Value);number(Value) ->
955		    #valuedef{value=Value}
956	    end;
957	false ->
958	    exit({error,{'no unique value',Fields,UniqueFieldName},S})
959%%	    io:format("WARNING: no unique value in object"),
960%%	    exit(uniqueFieldName)
961    end.
962
963check_uniqueness(NameValueList) ->
964    check_uniqueness1(lists:keysort(2,NameValueList)).
965
966check_uniqueness1([]) ->
967    true;
968check_uniqueness1([_]) ->
969    true;
970check_uniqueness1([{_,N,_},{_,N,_}|_Rest]) ->
971    throw({asn1_error,{'objects in set must have unique values in UNIQUE fields',N}});
972check_uniqueness1([_|Rest]) ->
973    check_uniqueness1(Rest).
974
975%% instantiate_po/4
976%% ClassDef is the class of Object,
977%% Object is the Parameterized object, which is referenced,
978%% ArgsList is the list of actual parameters
979%% returns an #'Object' record.
980instantiate_po(S,_ClassDef,Object,ArgsList) when record(Object,pobjectdef) ->
981    FormalParams = get_pt_args(Object),
982    MatchedArgs = match_args(FormalParams,ArgsList,[]),
983    NewS = S#state{type=Object,parameters=MatchedArgs},
984    check_object(NewS,Object,#'Object'{classname=Object#pobjectdef.class,
985				    def=Object#pobjectdef.def}).
986
987%% instantiate_pos/4
988%% ClassDef is the class of ObjectSetDef,
989%% ObjectSetDef is the Parameterized object set, which is referenced
990%% on the right side of the assignment,
991%% ArgsList is the list of actual parameters, i.e. real objects
992instantiate_pos(S,ClassDef,ObjectSetDef,ArgsList) ->
993    ClassName = ClassDef#classdef.name,
994    FormalParams = get_pt_args(ObjectSetDef),
995    Set = case get_pt_spec(ObjectSetDef) of
996	      {valueset,_Set} -> _Set;
997	      _Set -> _Set
998	  end,
999    MatchedArgs = match_args(FormalParams,ArgsList,[]),
1000    NewS = S#state{type=ObjectSetDef,parameters=MatchedArgs},
1001    check_object(NewS,ObjectSetDef,
1002		 #'ObjectSet'{class=name2Extref(S#state.mname,ClassName),
1003			      set=Set}).
1004
1005
1006%% gen_incl -> boolean()
1007%% If object with Fields has any of the corresponding class' typefields
1008%% then return value is true otherwise it is false.
1009%% If an object lacks a typefield but the class has a type field that
1010%% is OPTIONAL then we want gen to be true
1011gen_incl(S,{_,_,Fields},CFields)->
1012    gen_incl1(S,Fields,CFields).
1013
1014gen_incl1(_,_,[]) ->
1015    false;
1016gen_incl1(S,Fields,[C|CFields]) ->
1017    case element(1,C) of
1018	typefield ->
1019% 	    case lists:keymember(element(2,C),1,Fields) of
1020% 		true ->
1021% 		    true;
1022% 		false ->
1023% 		    gen_incl1(S,Fields,CFields)
1024% 	    end;
1025	    true; %% should check that field is OPTIONAL or DEFUALT if
1026                  %% the object lacks this field
1027	objectfield ->
1028	    case lists:keysearch(element(2,C),1,Fields) of
1029		{value,Field} ->
1030		    Type = element(3,C),
1031		    {_,ClassDef} = get_referenced_type(S,Type#type.def),
1032%		    {_,ClassFields,_} = ClassDef#classdef.typespec,
1033		    #objectclass{fields=ClassFields} =
1034			ClassDef#classdef.typespec,
1035		    ObjTDef = element(2,Field),
1036		    case gen_incl(S,(ObjTDef#typedef.typespec)#'Object'.def,
1037				  ClassFields) of
1038			true ->
1039			    true;
1040			_ ->
1041			    gen_incl1(S,Fields,CFields)
1042		    end;
1043		_ ->
1044		    gen_incl1(S,Fields,CFields)
1045	    end;
1046	_ ->
1047	    gen_incl1(S,Fields,CFields)
1048    end.
1049
1050%% first if no unique field in the class return false.(don't generate code)
1051gen_incl_set(S,Fields,ClassDef) ->
1052    case catch get_unique_fieldname(ClassDef) of
1053	Tuple when tuple(Tuple) ->
1054	    false;
1055	_ ->
1056	    gen_incl_set1(S,Fields,
1057			  (ClassDef#classdef.typespec)#objectclass.fields)
1058    end.
1059
1060%% if any of the existing or potentially existing objects has a typefield
1061%% then return true.
1062gen_incl_set1(_,[],_CFields)->
1063    false;
1064gen_incl_set1(_,['EXTENSIONMARK'],_) ->
1065    true;
1066%% Fields are the fields of an object in the object set.
1067%% CFields are the fields of the class of the object set.
1068gen_incl_set1(S,[Object|Rest],CFields)->
1069    Fields = element(size(Object),Object),
1070    case gen_incl1(S,Fields,CFields) of
1071	true ->
1072	    true;
1073	false ->
1074	    gen_incl_set1(S,Rest,CFields)
1075    end.
1076
1077check_objectdefn(S,Def,CDef) when record(CDef,classdef) ->
1078    WithSyntax = (CDef#classdef.typespec)#objectclass.syntax,
1079    ClassFields = (CDef#classdef.typespec)#objectclass.fields,
1080    case Def of
1081	{object,defaultsyntax,Fields} ->
1082	    check_defaultfields(S,Fields,ClassFields);
1083	{object,definedsyntax,Fields} ->
1084	    {_,WSSpec} = WithSyntax,
1085	    NewFields =
1086		case catch( convert_definedsyntax(S,Fields,WSSpec,
1087						  ClassFields,[])) of
1088		    {asn1,{_ErrorType,ObjToken,ClassToken}} ->
1089			throw({asn1,{'match error in object',ObjToken,
1090				     'found in object',ClassToken,'found in class'}});
1091		    Err={asn1,_} -> throw(Err);
1092		    Err={'EXIT',_} -> throw(Err);
1093		    DefaultFields when list(DefaultFields) ->
1094			DefaultFields
1095		end,
1096	    {object,defaultsyntax,NewFields};
1097	{object,_ObjectId} -> % This is a DefinedObject
1098	    fixa;
1099	Other ->
1100	    exit({error,{objectdefn,Other}})
1101    end.
1102
1103check_defaultfields(S,Fields,ClassFields) ->
1104    check_defaultfields(S,Fields,ClassFields,[]).
1105
1106check_defaultfields(_S,[],_ClassFields,Acc) ->
1107    {object,defaultsyntax,lists:reverse(Acc)};
1108check_defaultfields(S,[{FName,Spec}|Fields],ClassFields,Acc) ->
1109    case lists:keysearch(FName,2,ClassFields) of
1110	{value,CField} ->
1111	    NewField = convert_to_defaultfield(S,FName,Spec,CField),
1112	    check_defaultfields(S,Fields,ClassFields,[NewField|Acc]);
1113	_ ->
1114	    throw({error,{asn1,{'unvalid field in object',FName}}})
1115    end.
1116%%    {object,defaultsyntax,Fields}.
1117
1118convert_definedsyntax(_S,[],[],_ClassFields,Acc) ->
1119    lists:reverse(Acc);
1120convert_definedsyntax(S,Fields,WithSyntax,ClassFields,Acc) ->
1121    case match_field(S,Fields,WithSyntax,ClassFields) of
1122	{MatchedField,RestFields,RestWS} ->
1123	    if
1124		list(MatchedField) ->
1125		    convert_definedsyntax(S,RestFields,RestWS,ClassFields,
1126					  lists:append(MatchedField,Acc));
1127		true ->
1128		    convert_definedsyntax(S,RestFields,RestWS,ClassFields,
1129					  [MatchedField|Acc])
1130	    end
1131%%	    throw({error,{asn1,{'unvalid syntax in object',WorS}}})
1132    end.
1133
1134match_field(S,Fields,WithSyntax,ClassFields) ->
1135    match_field(S,Fields,WithSyntax,ClassFields,[]).
1136
1137match_field(S,Fields,[W|Ws],ClassFields,Acc) when list(W) ->
1138    case catch(match_optional_field(S,Fields,W,ClassFields,[])) of
1139	{'EXIT',_} ->
1140	    match_field(Fields,Ws,ClassFields,Acc); %% add S
1141%%	{[Result],RestFields} ->
1142%%	    {Result,RestFields,Ws};
1143	{Result,RestFields} when list(Result) ->
1144	    {Result,RestFields,Ws};
1145	_ ->
1146	    match_field(S,Fields,Ws,ClassFields,Acc)
1147    end;
1148match_field(S,Fields,WithSyntax,ClassFields,_Acc) ->
1149    match_mandatory_field(S,Fields,WithSyntax,ClassFields,[]).
1150
1151match_optional_field(_S,RestFields,[],_,Ret) ->
1152    {Ret,RestFields};
1153%% An additional optional field within an optional field
1154match_optional_field(S,Fields,[W|Ws],ClassFields,Ret) when list(W) ->
1155    case catch match_optional_field(S,Fields,W,ClassFields,[]) of
1156	{'EXIT',_} ->
1157	    {Ret,Fields};
1158	{asn1,{optional_matcherror,_,_}} ->
1159	    {Ret,Fields};
1160	{OptionalField,RestFields} ->
1161	    match_optional_field(S,RestFields,Ws,ClassFields,
1162				 lists:append(OptionalField,Ret))
1163    end;
1164%% identify and skip word
1165%match_optional_field(S,[#'Externaltypereference'{type=WorS}|Rest],
1166match_optional_field(S,[{_,_,WorS}|Rest],
1167		     [WorS|Ws],ClassFields,Ret) ->
1168    match_optional_field(S,Rest,Ws,ClassFields,Ret);
1169match_optional_field(S,[],_,ClassFields,Ret) ->
1170    match_optional_field(S,[],[],ClassFields,Ret);
1171%% identify and skip comma
1172match_optional_field(S,[{WorS,_}|Rest],[{WorS,_}|Ws],ClassFields,Ret) ->
1173    match_optional_field(S,Rest,Ws,ClassFields,Ret);
1174%% identify and save field data
1175match_optional_field(S,[Setting|Rest],[{_,W}|Ws],ClassFields,Ret) ->
1176    WorS =
1177	case Setting of
1178	    Type when record(Type,type) -> Type;
1179%%	    #'Externalvaluereference'{value=WordOrSetting} -> WordOrSetting;
1180	    {'ValueFromObject',_,_} -> Setting;
1181	    {object,_,_} -> Setting;
1182	    {_,_,WordOrSetting} -> WordOrSetting;
1183%%	    Atom when atom(Atom) -> Atom
1184	    Other -> Other
1185	end,
1186    case lists:keysearch(W,2,ClassFields) of
1187	false ->
1188	    throw({asn1,{optional_matcherror,WorS,W}});
1189	{value,CField} ->
1190	    NewField = convert_to_defaultfield(S,W,WorS,CField),
1191	    match_optional_field(S,Rest,Ws,ClassFields,[NewField|Ret])
1192    end;
1193match_optional_field(_S,[WorS|_Rest],[W|_Ws],_ClassFields,_Ret) ->
1194    throw({asn1,{optional_matcherror,WorS,W}}).
1195
1196match_mandatory_field(_S,[],[],_,[Acc]) ->
1197    {Acc,[],[]};
1198match_mandatory_field(_S,[],[],_,Acc) ->
1199    {Acc,[],[]};
1200match_mandatory_field(S,[],[H|T],CF,Acc) when list(H) ->
1201    match_mandatory_field(S,[],T,CF,Acc);
1202match_mandatory_field(_S,[],WithSyntax,_,_Acc) ->
1203    throw({asn1,{mandatory_matcherror,[],WithSyntax}});
1204%match_mandatory_field(_S,Fields,WithSyntax=[W|_Ws],_ClassFields,[Acc]) when list(W) ->
1205match_mandatory_field(_S,Fields,WithSyntax=[W|_Ws],_ClassFields,Acc) when list(W), length(Acc) >= 1 ->
1206    {Acc,Fields,WithSyntax};
1207%% identify and skip word
1208match_mandatory_field(S,[{_,_,WorS}|Rest],
1209		      [WorS|Ws],ClassFields,Acc) ->
1210    match_mandatory_field(S,Rest,Ws,ClassFields,Acc);
1211%% identify and skip comma
1212match_mandatory_field(S,[{WorS,_}|Rest],[{WorS,_}|Ws],ClassFields,Ret) ->
1213    match_mandatory_field(S,Rest,Ws,ClassFields,Ret);
1214%% identify and save field data
1215match_mandatory_field(S,[Setting|Rest],[{_,W}|Ws],ClassFields,Acc) ->
1216    WorS =
1217	case Setting of
1218%%	    Atom when atom(Atom) -> Atom;
1219%%	    #'Externalvaluereference'{value=WordOrSetting} -> WordOrSetting;
1220	    {object,_,_} -> Setting;
1221	    {_,_,WordOrSetting} -> WordOrSetting;
1222	    Type when record(Type,type) -> Type;
1223	    Other -> Other
1224	end,
1225    case lists:keysearch(W,2,ClassFields) of
1226	false ->
1227	    throw({asn1,{mandatory_matcherror,WorS,W}});
1228	{value,CField} ->
1229	    NewField = convert_to_defaultfield(S,W,WorS,CField),
1230	    match_mandatory_field(S,Rest,Ws,ClassFields,[NewField|Acc])
1231    end;
1232
1233match_mandatory_field(_S,[WorS|_Rest],[W|_Ws],_ClassFields,_Acc) ->
1234    throw({asn1,{mandatory_matcherror,WorS,W}}).
1235
1236%% Converts a field of an object from defined syntax to default syntax
1237convert_to_defaultfield(S,ObjFieldName,ObjFieldSetting,CField)->
1238    CurrMod = S#state.mname,
1239    case element(1,CField) of
1240	typefield ->
1241	    TypeDef=
1242		case ObjFieldSetting of
1243		    TypeRec when record(TypeRec,type) -> TypeRec#type.def;
1244		    TDef when record(TDef,typedef) ->
1245			TDef#typedef{typespec=check_type(S,TDef,
1246							 TDef#typedef.typespec)};
1247		    _ -> ObjFieldSetting
1248		end,
1249	    Type =
1250		if
1251		    record(TypeDef,typedef) -> TypeDef;
1252		    true ->
1253			case asn1ct_gen:type(asn1ct_gen:get_inner(TypeDef)) of
1254			    ERef = #'Externaltypereference'{module=CurrMod} ->
1255				{_,T} = get_referenced_type(S,ERef),
1256				T#typedef{checked=true,
1257					  typespec=check_type(S,T,
1258							      T#typedef.typespec)};
1259			    ERef = #'Externaltypereference'{module=ExtMod} ->
1260				{_,T} = get_referenced_type(S,ERef),
1261				#typedef{name=Name} = T,
1262				check_type(S,T,T#typedef.typespec),
1263				#typedef{checked=true,
1264					 name={ExtMod,Name},
1265					 typespec=ERef};
1266			    Bif when Bif=={primitive,bif};Bif=={constructed,bif} ->
1267				T = check_type(S,#typedef{typespec=ObjFieldSetting},
1268					       ObjFieldSetting),
1269				#typedef{checked=true,name=Bif,typespec=T};
1270			    _ ->
1271				{Mod,T} =
1272				    %% get_referenced_type(S,#typereference{val=ObjFieldSetting}),
1273				    get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=ObjFieldSetting}),
1274				case Mod of
1275				    CurrMod ->
1276					T;
1277				    ExtMod ->
1278					#typedef{name=Name} = T,
1279					T#typedef{name={ExtMod,Name}}
1280				end
1281			end
1282		end,
1283	    {ObjFieldName,Type};
1284	fixedtypevaluefield ->
1285	    case ObjFieldName of
1286		Val when atom(Val) ->
1287		    %% ObjFieldSetting can be a value,an objectidentifiervalue,
1288		    %% an element in an enumeration or namednumberlist etc.
1289		    ValRef =
1290			case ObjFieldSetting of
1291			    #'Externalvaluereference'{} -> ObjFieldSetting;
1292			    {'ValueFromObject',{_,ObjRef},FieldName} ->
1293				{_,Object} = get_referenced_type(S,ObjRef),
1294				ChObject = check_object(S,Object,
1295							Object#typedef.typespec),
1296				get_fieldname_element(S,Object#typedef{typespec=ChObject},
1297						      FieldName);
1298			    #valuedef{} ->
1299				ObjFieldSetting;
1300			    _ ->
1301				#identifier{val=ObjFieldSetting}
1302			end,
1303		    case ValRef of
1304			#valuedef{} ->
1305			    {ObjFieldName,check_value(S,ValRef)};
1306			_ ->
1307			    ValDef =
1308				case catch get_referenced_type(S,ValRef) of
1309				    {error,_} ->
1310					check_value(S,#valuedef{name=Val,
1311								type=element(3,CField),
1312								value=ObjFieldSetting});
1313				    {_,VDef} when record(VDef,valuedef) ->
1314					check_value(S,VDef);%% XXX
1315				    {_,VDef} ->
1316					check_value(S,#valuedef{name=Val,
1317								type=element(3,CField),
1318								value=VDef})
1319				end,
1320			    {ObjFieldName,ValDef}
1321		    end;
1322		Val ->
1323		    {ObjFieldName,Val}
1324	    end;
1325	fixedtypevaluesetfield ->
1326	    {ObjFieldName,ObjFieldSetting};
1327	objectfield ->
1328	    ObjectSpec =
1329		case ObjFieldSetting of
1330		    Ref when record(Ref,typereference);record(Ref,identifier);
1331			     record(Ref,'Externaltypereference');
1332			     record(Ref,'Externalvaluereference') ->
1333			{_,R} = get_referenced_type(S,ObjFieldSetting),
1334			R;
1335		    {'ValueFromObject',{_,ObjRef},FieldName} ->
1336			%% This is an ObjectFromObject
1337			{_,Object} = get_referenced_type(S,ObjRef),
1338			ChObject = check_object(S,Object,
1339						Object#typedef.typespec),
1340			_ObjFromObj=
1341			    get_fieldname_element(S,Object#typedef{
1342						      typespec=ChObject},
1343						  FieldName);
1344			%%ClassName = ObjFromObj#'Object'.classname,
1345			%%#typedef{name=,
1346			%%	 typespec=
1347			%%	 ObjFromObj#'Object'{classname=
1348			%%			     {objectclassname,ClassName}}};
1349		    {object,_,_} ->
1350			%% An object defined inlined in another object
1351			#type{def=Ref} = element(3,CField),
1352% 			CRef = case Ref of
1353% 				   #'Externaltypereference'{module=CurrMod,
1354% 							    type=CName} ->
1355% 				       CName;
1356% 				    #'Externaltypereference'{module=ExtMod,
1357% 							    type=CName} ->
1358% 				       {ExtMod,CName}
1359% 			       end,
1360			InlinedObjName=
1361			    list_to_atom(lists:concat([S#state.tname]++
1362						      ['_',ObjFieldName])),
1363%			ObjSpec = #'Object'{classname={objectclassname,CRef},
1364			ObjSpec = #'Object'{classname=Ref,
1365					    def=ObjFieldSetting},
1366			CheckedObj=
1367			    check_object(S,#typedef{typespec=ObjSpec},ObjSpec),
1368			InlObj = #typedef{checked=true,name=InlinedObjName,
1369					  typespec=CheckedObj},
1370			asn1ct_gen:insert_once(inlined_objects,{InlinedObjName,
1371								InlinedObjName}),
1372			asn1_db:dbput(S#state.mname,InlinedObjName,InlObj),
1373			InlObj;
1374		    #type{def=Eref} when record(Eref,'Externaltypereference') ->
1375			{_,R} = get_referenced_type(S,Eref),
1376			R;
1377		    _ ->
1378%%			{_,R} = get_referenced_type(S,#typereference{val=ObjFieldSetting}),
1379			{_,R} = get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=ObjFieldSetting}),
1380			R
1381		end,
1382	    {ObjFieldName,
1383	     ObjectSpec#typedef{checked=true,
1384		      typespec=check_object(S,ObjectSpec,
1385					    ObjectSpec#typedef.typespec)}};
1386	variabletypevaluefield ->
1387	    {ObjFieldName,ObjFieldSetting};
1388	variabletypevaluesetfield ->
1389	    {ObjFieldName,ObjFieldSetting};
1390	objectsetfield ->
1391	    {_,ObjSetSpec} =
1392		case ObjFieldSetting of
1393		    Ref when record(Ref,'Externaltypereference');
1394			     record(Ref,'Externalvaluereference') ->
1395			get_referenced_type(S,ObjFieldSetting);
1396		    ObjectList when list(ObjectList) ->
1397			%% an objctset defined in the object,though maybe
1398			%% parsed as a SequenceOfValue
1399			%% The ObjectList may be a list of references to
1400			%% objects, a ValueFromObject
1401			{_,_,Type,_} = CField,
1402			ClassDef = Type#type.def,
1403			case ClassDef#'Externaltypereference'.module of
1404			    CurrMod ->
1405				ClassDef#'Externaltypereference'.type;
1406			    ExtMod ->
1407				{ExtMod,
1408				 ClassDef#'Externaltypereference'.type}
1409			end,
1410			{no_name,
1411			 #typedef{typespec=
1412				  #'ObjectSet'{class=
1413%					       {objectclassname,ClassRef},
1414					       ClassDef,
1415					       set=ObjectList}}};
1416		    ObjectSet={'SingleValue',_} ->
1417			%% a Union of defined objects
1418			{_,_,Type,_} = CField,
1419			ClassDef = Type#type.def,
1420% 			ClassRef =
1421% 			    case ClassDef#'Externaltypereference'.module of
1422% 				CurrMod ->
1423% 				    ClassDef#'Externaltypereference'.type;
1424% 				ExtMod ->
1425% 				    {ExtMod,
1426% 				     ClassDef#'Externaltypereference'.type}
1427% 			    end,
1428			{no_name,
1429%			 #typedef{typespec=#'ObjectSet'{class={objectclassname,ClassRef},
1430			 #typedef{typespec=#'ObjectSet'{class=ClassDef,
1431							set=ObjectSet}}};
1432		    {object,_,[#type{def={'TypeFromObject',
1433					 {object,RefedObj},
1434					 FieldName}}]} ->
1435			%% This case occurs when an ObjectSetFromObjects
1436			%% production is used
1437			{M,Def} = get_referenced_type(S,RefedObj),
1438			{M,get_fieldname_element(S,Def,FieldName)};
1439		    #type{def=Eref} when
1440			  record(Eref,'Externaltypereference') ->
1441			get_referenced_type(S,Eref);
1442		    _ ->
1443%%			get_referenced_type(S,#typereference{val=ObjFieldSetting})
1444			get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=ObjFieldSetting})
1445		end,
1446	    {ObjFieldName,
1447	     ObjSetSpec#typedef{checked=true,
1448				typespec=check_object(S,ObjSetSpec,
1449						      ObjSetSpec#typedef.typespec)}}
1450    end.
1451
1452check_value(OldS,V) when record(V,pvaluesetdef) ->
1453    #pvaluesetdef{checked=Checked,type=Type} = V,
1454    case Checked of
1455	true -> V;
1456	{error,_} -> V;
1457	false ->
1458	    case get_referenced_type(OldS,Type#type.def) of
1459		{_,Class} when record(Class,classdef) ->
1460		    throw({pobjectsetdef});
1461		_ -> continue
1462	    end
1463    end;
1464check_value(_OldS,V) when record(V,pvaluedef) ->
1465    %% Fix this case later
1466    V;
1467check_value(OldS,V) when record(V,typedef) ->
1468    %% This case when a value set has been parsed as an object set.
1469    %% It may be a value set
1470    #typedef{typespec=TS} = V,
1471    case TS of
1472	#'ObjectSet'{class=ClassRef} ->
1473	    {_,TSDef} = get_referenced_type(OldS,ClassRef),
1474	    %%IsObjectSet(TSDef);
1475	    case TSDef of
1476		#classdef{} -> throw({objectsetdef});
1477		#typedef{typespec=#type{def=Eref}} when
1478		      record(Eref,'Externaltypereference') ->
1479		    %% This case if the class reference is a defined
1480		    %% reference to class
1481		    check_value(OldS,V#typedef{typespec=TS#'ObjectSet'{class=Eref}});
1482		#typedef{} ->
1483		    % an ordinary value set with a type in #typedef.typespec
1484		    ValueSet = TS#'ObjectSet'.set,
1485		    Type=check_type(OldS,TSDef,TSDef#typedef.typespec),
1486		    Value = check_value(OldS,#valuedef{type=Type,
1487						       value=ValueSet}),
1488		    {valueset,Type#type{constraint=Value#valuedef.value}}
1489	    end;
1490	_ ->
1491	    throw({objectsetdef})
1492    end;
1493check_value(S,#valuedef{pos=Pos,name=Name,type=Type,
1494			  value={valueset,Constr}}) ->
1495    NewType = Type#type{constraint=[Constr]},
1496    {valueset,
1497     check_type(S,#typedef{pos=Pos,name=Name,typespec=NewType},NewType)};
1498check_value(OldS=#state{recordtopname=TopName},V) when record(V,valuedef) ->
1499    #valuedef{name=Name,checked=Checked,type=Vtype,value=Value} = V,
1500    case Checked of
1501	true ->
1502	    V;
1503	{error,_} ->
1504	    V;
1505	false ->
1506	    Def = Vtype#type.def,
1507	    Constr = Vtype#type.constraint,
1508	    S = OldS#state{type=Vtype,tname=Def,value=V,vname=Name},
1509	    NewDef =
1510		case Def of
1511		    Ext when record(Ext,'Externaltypereference') ->
1512			RecName = Ext#'Externaltypereference'.type,
1513			{_,Type} = get_referenced_type(S,Ext),
1514			%% If V isn't a value but an object Type is a #classdef{}
1515			case Type of
1516			    #classdef{} ->
1517				throw({objectdef});
1518			    #typedef{} ->
1519				case is_contextswitchtype(Type) of
1520				    true ->
1521					#valuedef{value=CheckedVal}=
1522					    check_value(S,V#valuedef{type=Type#typedef.typespec}),
1523					#newv{value=CheckedVal};
1524				    _ ->
1525					#valuedef{value=CheckedVal}=
1526					    check_value(S#state{recordtopname=[RecName|TopName]},
1527							V#valuedef{type=Type#typedef.typespec}),
1528					#newv{value=CheckedVal}
1529				end
1530			end;
1531		    'ANY' ->
1532			throw({error,{asn1,{'cant check value of type',Def}}});
1533		    'INTEGER' ->
1534			validate_integer(S,Value,[],Constr),
1535			#newv{value=normalize_value(S,Vtype,Value,[])};
1536		    {'INTEGER',NamedNumberList} ->
1537			validate_integer(S,Value,NamedNumberList,Constr),
1538			#newv{value=normalize_value(S,Vtype,Value,[])};
1539		    {'BIT STRING',NamedNumberList} ->
1540			validate_bitstring(S,Value,NamedNumberList,Constr),
1541			#newv{value=normalize_value(S,Vtype,Value,[])};
1542		    'NULL' ->
1543			validate_null(S,Value,Constr),
1544			#newv{};
1545		    'OBJECT IDENTIFIER' ->
1546			validate_objectidentifier(S,Value,Constr),
1547			#newv{value = normalize_value(S,Vtype,Value,[])};
1548		    'ObjectDescriptor' ->
1549			validate_objectdescriptor(S,Value,Constr),
1550			#newv{value=normalize_value(S,Vtype,Value,[])};
1551		    {'ENUMERATED',NamedNumberList} ->
1552			validate_enumerated(S,Value,NamedNumberList,Constr),
1553			#newv{value=normalize_value(S,Vtype,Value,[])};
1554		    'BOOLEAN'->
1555			validate_boolean(S,Value,Constr),
1556			#newv{value=normalize_value(S,Vtype,Value,[])};
1557		    'OCTET STRING' ->
1558			validate_octetstring(S,Value,Constr),
1559			#newv{value=normalize_value(S,Vtype,Value,[])};
1560		    'NumericString' ->
1561			validate_restrictedstring(S,Value,Def,Constr),
1562			#newv{value=normalize_value(S,Vtype,Value,[])};
1563		    'TeletexString' ->
1564			validate_restrictedstring(S,Value,Def,Constr),
1565			#newv{value=normalize_value(S,Vtype,Value,[])};
1566		    'VideotexString' ->
1567			validate_restrictedstring(S,Value,Def,Constr),
1568			#newv{value=normalize_value(S,Vtype,Value,[])};
1569		    'UTCTime' ->
1570			#newv{value=normalize_value(S,Vtype,Value,[])};
1571%			exit({'cant check value of type' ,Def});
1572		    'GeneralizedTime' ->
1573			#newv{value=normalize_value(S,Vtype,Value,[])};
1574%			exit({'cant check value of type' ,Def});
1575		    'GraphicString' ->
1576			validate_restrictedstring(S,Value,Def,Constr),
1577			#newv{value=normalize_value(S,Vtype,Value,[])};
1578		    'VisibleString' ->
1579			validate_restrictedstring(S,Value,Def,Constr),
1580			#newv{value=normalize_value(S,Vtype,Value,[])};
1581		    'GeneralString' ->
1582			validate_restrictedstring(S,Value,Def,Constr),
1583			#newv{value=normalize_value(S,Vtype,Value,[])};
1584		    'PrintableString' ->
1585			validate_restrictedstring(S,Value,Def,Constr),
1586			#newv{value=normalize_value(S,Vtype,Value,[])};
1587		    'IA5String' ->
1588			validate_restrictedstring(S,Value,Def,Constr),
1589			#newv{value=normalize_value(S,Vtype,Value,[])};
1590		    'BMPString' ->
1591			validate_restrictedstring(S,Value,Def,Constr),
1592			#newv{value=normalize_value(S,Vtype,Value,[])};
1593%%		    'UniversalString' -> %added 6/12 -00
1594%%			#newv{value=validate_restrictedstring(S,Value,Def,Constr)};
1595		    Seq when record(Seq,'SEQUENCE') ->
1596			SeqVal = validate_sequence(S,Value,
1597						   Seq#'SEQUENCE'.components,
1598						   Constr),
1599			#newv{value=normalize_value(S,Vtype,SeqVal,TopName)};
1600		    {'SEQUENCE OF',Components} ->
1601			validate_sequenceof(S,Value,Components,Constr),
1602			#newv{value=normalize_value(S,Vtype,Value,TopName)};
1603		    {'CHOICE',Components} ->
1604			validate_choice(S,Value,Components,Constr),
1605			#newv{value=normalize_value(S,Vtype,Value,TopName)};
1606		    Set when record(Set,'SET') ->
1607			validate_set(S,Value,Set#'SET'.components,
1608					      Constr),
1609			#newv{value=normalize_value(S,Vtype,Value,TopName)};
1610		    {'SET OF',Components} ->
1611			validate_setof(S,Value,Components,Constr),
1612			#newv{value=normalize_value(S,Vtype,Value,TopName)};
1613		    Other ->
1614			exit({'cant check value of type' ,Other})
1615		end,
1616	    case NewDef#newv.value of
1617		unchanged ->
1618		    V#valuedef{checked=true,value=Value};
1619		ok ->
1620		    V#valuedef{checked=true,value=Value};
1621		{error,Reason} ->
1622		    V#valuedef{checked={error,Reason},value=Value};
1623		_V ->
1624		    V#valuedef{checked=true,value=_V}
1625	    end
1626    end.
1627
1628is_contextswitchtype(#typedef{name='EXTERNAL'})->
1629    true;
1630is_contextswitchtype(#typedef{name='EMBEDDED PDV'}) ->
1631    true;
1632is_contextswitchtype(#typedef{name='CHARACTER STRING'}) ->
1633    true;
1634is_contextswitchtype(_) ->
1635    false.
1636
1637% validate_integer(S,{identifier,Pos,Id},NamedNumberList,Constr) ->
1638%     case lists:keysearch(Id,1,NamedNumberList) of
1639% 	{value,_} -> ok;
1640% 	false -> error({value,"unknown NamedNumber",S})
1641%     end;
1642%% This case occurs when there is a valuereference
1643validate_integer(S=#state{mname=M},
1644		 #'Externalvaluereference'{module=M,value=Id},
1645		 NamedNumberList,_Constr) ->
1646    case lists:keysearch(Id,1,NamedNumberList) of
1647	{value,_} -> ok;
1648	false -> error({value,"unknown NamedNumber",S})
1649    end;
1650validate_integer(S,Id,NamedNumberList,_Constr) when atom(Id) ->
1651    case lists:keysearch(Id,1,NamedNumberList) of
1652	{value,_} -> ok;
1653	false -> error({value,"unknown NamedNumber",S})
1654    end;
1655validate_integer(_S,Value,_NamedNumberList,Constr) when integer(Value) ->
1656    check_integer_range(Value,Constr).
1657
1658check_integer_range(Int,Constr) when list(Constr) ->
1659    NewConstr = [X || #constraint{c=X} <- Constr],
1660    check_constr(Int,NewConstr);
1661
1662check_integer_range(_Int,_Constr) ->
1663    %%io:format("~p~n",[Constr]),
1664    ok.
1665
1666check_constr(Int,[{'ValueRange',Lb,Ub}|T]) when Int >= Lb, Int =< Ub ->
1667    check_constr(Int,T);
1668check_constr(_Int,[]) ->
1669    ok.
1670
1671validate_bitstring(_S,_Value,_NamedNumberList,_Constr) ->
1672    ok.
1673
1674validate_null(_S,'NULL',_Constr) ->
1675    ok.
1676
1677%%------------
1678%% This can be removed when the old parser is removed
1679%% The function removes 'space' atoms from the list
1680
1681is_space_list([H],Acc) ->
1682    lists:reverse([H|Acc]);
1683is_space_list([H,space|T],Acc) ->
1684    is_space_list(T,[H|Acc]);
1685is_space_list([],Acc) ->
1686    lists:reverse(Acc);
1687is_space_list([H|T],Acc) ->
1688    is_space_list(T,[H|Acc]).
1689
1690validate_objectidentifier(S,L,_) ->
1691    case is_space_list(L,[]) of
1692	NewL when list(NewL) ->
1693	    case validate_objectidentifier1(S,NewL) of
1694		NewL2 when list(NewL2) ->
1695		    list_to_tuple(NewL2);
1696		Other -> Other
1697	    end;
1698	{error,_} ->
1699	    error({value, "illegal OBJECT IDENTIFIER", S})
1700    end.
1701
1702validate_objectidentifier1(S, [Id|T]) when record(Id,'Externalvaluereference') ->
1703    case catch get_referenced_type(S,Id) of
1704	{_,V} when record(V,valuedef) ->
1705	    case check_value(S,V) of
1706		#valuedef{type=#type{def='OBJECT IDENTIFIER'},
1707			  checked=true,value=Value} when tuple(Value) ->
1708		    validate_objectid(S, T, lists:reverse(tuple_to_list(Value)));
1709		_ ->
1710		    error({value, "illegal OBJECT IDENTIFIER", S})
1711	    end;
1712	_ ->
1713	    validate_objectid(S, [Id|T], [])
1714    end;
1715validate_objectidentifier1(S,V) ->
1716    validate_objectid(S,V,[]).
1717
1718validate_objectid(_, [], Acc) ->
1719    lists:reverse(Acc);
1720validate_objectid(S, [Value|Vrest], Acc) when integer(Value) ->
1721    validate_objectid(S, Vrest, [Value|Acc]);
1722validate_objectid(S, [{'NamedNumber',_Name,Value}|Vrest], Acc)
1723  when integer(Value) ->
1724    validate_objectid(S, Vrest, [Value|Acc]);
1725validate_objectid(S, [Id|Vrest], Acc)
1726  when record(Id,'Externalvaluereference') ->
1727    case catch get_referenced_type(S, Id) of
1728	{_,V} when record(V,valuedef) ->
1729	    case check_value(S, V) of
1730		#valuedef{checked=true,value=Value} when integer(Value) ->
1731		    validate_objectid(S, Vrest, [Value|Acc]);
1732		_ ->
1733		    error({value, "illegal OBJECT IDENTIFIER", S})
1734	    end;
1735	_ ->
1736	    case reserved_objectid(Id#'Externalvaluereference'.value, Acc) of
1737		Value when integer(Value) ->
1738		    validate_objectid(S, Vrest, [Value|Acc]);
1739		false ->
1740		    error({value, "illegal OBJECT IDENTIFIER", S})
1741	    end
1742    end;
1743validate_objectid(S, [{Atom,Value}],[]) when atom(Atom),integer(Value) ->
1744    %% this case when an OBJECT IDENTIFIER value has been parsed as a
1745    %% SEQUENCE value
1746    Rec = #'Externalvaluereference'{module=S#state.mname,
1747				    value=Atom},
1748    validate_objectidentifier1(S,[Rec,Value]);
1749validate_objectid(S, [{Atom,EVRef}],[])
1750  when atom(Atom),record(EVRef,'Externalvaluereference') ->
1751    %% this case when an OBJECT IDENTIFIER value has been parsed as a
1752    %% SEQUENCE value OTP-4354
1753    Rec = #'Externalvaluereference'{module=S#state.mname,
1754				    value=Atom},
1755    validate_objectidentifier1(S,[Rec,EVRef]);
1756validate_objectid(S, _V, _Acc) ->
1757    error({value, "illegal OBJECT IDENTIFIER",S}).
1758
1759
1760%% ITU-T Rec. X.680 Annex B - D
1761reserved_objectid('itu-t',[]) -> 0;
1762reserved_objectid('ccitt',[]) -> 0;
1763%% arcs below "itu-t"
1764reserved_objectid('recommendation',[0]) -> 0;
1765reserved_objectid('question',[0]) -> 1;
1766reserved_objectid('administration',[0]) -> 2;
1767reserved_objectid('network-operator',[0]) -> 3;
1768reserved_objectid('identified-organization',[0]) -> 4;
1769%% arcs below "recommendation"
1770reserved_objectid('a',[0,0]) -> 1;
1771reserved_objectid('b',[0,0]) -> 2;
1772reserved_objectid('c',[0,0]) -> 3;
1773reserved_objectid('d',[0,0]) -> 4;
1774reserved_objectid('e',[0,0]) -> 5;
1775reserved_objectid('f',[0,0]) -> 6;
1776reserved_objectid('g',[0,0]) -> 7;
1777reserved_objectid('h',[0,0]) -> 8;
1778reserved_objectid('i',[0,0]) -> 9;
1779reserved_objectid('j',[0,0]) -> 10;
1780reserved_objectid('k',[0,0]) -> 11;
1781reserved_objectid('l',[0,0]) -> 12;
1782reserved_objectid('m',[0,0]) -> 13;
1783reserved_objectid('n',[0,0]) -> 14;
1784reserved_objectid('o',[0,0]) -> 15;
1785reserved_objectid('p',[0,0]) -> 16;
1786reserved_objectid('q',[0,0]) -> 17;
1787reserved_objectid('r',[0,0]) -> 18;
1788reserved_objectid('s',[0,0]) -> 19;
1789reserved_objectid('t',[0,0]) -> 20;
1790reserved_objectid('u',[0,0]) -> 21;
1791reserved_objectid('v',[0,0]) -> 22;
1792reserved_objectid('w',[0,0]) -> 23;
1793reserved_objectid('x',[0,0]) -> 24;
1794reserved_objectid('y',[0,0]) -> 25;
1795reserved_objectid('z',[0,0]) -> 26;
1796
1797
1798reserved_objectid(iso,[]) -> 1;
1799%% arcs below "iso", note that number 1 is not used
1800reserved_objectid('standard',[1]) -> 0;
1801reserved_objectid('member-body',[1]) -> 2;
1802reserved_objectid('identified-organization',[1]) -> 3;
1803
1804reserved_objectid('joint-iso-itu-t',[]) -> 2;
1805reserved_objectid('joint-iso-ccitt',[]) -> 2;
1806
1807reserved_objectid(_,_) -> false.
1808
1809
1810
1811
1812
1813validate_objectdescriptor(_S,_Value,_Constr) ->
1814    ok.
1815
1816validate_enumerated(S,Id,NamedNumberList,_Constr) when atom(Id) ->
1817    case lists:keysearch(Id,1,NamedNumberList) of
1818	{value,_} -> ok;
1819	false -> error({value,"unknown ENUMERATED",S})
1820    end;
1821validate_enumerated(S,{identifier,_Pos,Id},NamedNumberList,_Constr) ->
1822    case lists:keysearch(Id,1,NamedNumberList) of
1823	{value,_} -> ok;
1824	false -> error({value,"unknown ENUMERATED",S})
1825    end;
1826validate_enumerated(S,#'Externalvaluereference'{value=Id},
1827		    NamedNumberList,_Constr) ->
1828    case lists:keysearch(Id,1,NamedNumberList) of
1829	{value,_} -> ok;
1830	false -> error({value,"unknown ENUMERATED",S})
1831    end.
1832
1833validate_boolean(_S,_Value,_Constr) ->
1834    ok.
1835
1836validate_octetstring(_S,_Value,_Constr) ->
1837    ok.
1838
1839validate_restrictedstring(_S,_Value,_Def,_Constr) ->
1840    ok.
1841
1842validate_sequence(S=#state{type=Vtype},Value,_Components,_Constr) ->
1843    case Vtype of
1844	#type{tag=[{tag,'UNIVERSAL',8,'IMPLICIT',32}]} ->
1845	    %% this is an 'EXTERNAL' (or INSTANCE OF)
1846	    case Value of
1847		[{identification,_}|_RestVal] ->
1848		    to_EXTERNAL1990(S,Value);
1849		_ ->
1850		    Value
1851	    end;
1852	_ ->
1853	    Value
1854    end.
1855
1856validate_sequenceof(_S,_Value,_Components,_Constr) ->
1857    ok.
1858
1859validate_choice(_S,_Value,_Components,_Constr) ->
1860    ok.
1861
1862validate_set(_S,_Value,_Components,_Constr) ->
1863    ok.
1864
1865validate_setof(_S,_Value,_Components,_Constr) ->
1866    ok.
1867
1868to_EXTERNAL1990(S,[{identification,{'CHOICE',{syntax,Stx}}}|Rest]) ->
1869    to_EXTERNAL1990(S,Rest,[{'direct-reference',Stx}]);
1870to_EXTERNAL1990(S,[{identification,{'CHOICE',{'presentation-context-id',I}}}|Rest]) ->
1871    to_EXTERNAL1990(S,Rest,[{'indirect-reference',I}]);
1872to_EXTERNAL1990(S,[{identification,{'CHOICE',{'context-negotiation',[{_,PCid},{_,TrStx}]}}}|Rest]) ->
1873    to_EXTERNAL1990(S,Rest,[{'indirect-reference',PCid},{'direct-reference',TrStx}]);
1874to_EXTERNAL1990(S,_) ->
1875    error({value,"illegal value in EXTERNAL type",S}).
1876
1877to_EXTERNAL1990(S,[V={'data-value-descriptor',_}|Rest],Acc) ->
1878    to_EXTERNAL1990(S,Rest,[V|Acc]);
1879to_EXTERNAL1990(_S,[{'data-value',Val}],Acc) ->
1880    Encoding = {encoding,{'CHOICE',{'octet-aligned',Val}}},
1881    lists:reverse([Encoding|Acc]);
1882to_EXTERNAL1990(S,_,_) ->
1883    error({value,"illegal value in EXTERNAL type",S}).
1884
1885%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1886%% Functions to normalize the default values of SEQUENCE
1887%% and SET components into Erlang valid format
1888%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1889normalize_value(_,_,mandatory,_) ->
1890    mandatory;
1891normalize_value(_,_,'OPTIONAL',_) ->
1892    'OPTIONAL';
1893normalize_value(S,Type,{'DEFAULT',Value},NameList) ->
1894    case catch get_canonic_type(S,Type,NameList) of
1895	{'BOOLEAN',CType,_} ->
1896	    normalize_boolean(S,Value,CType);
1897	{'INTEGER',CType,_} ->
1898	    normalize_integer(S,Value,CType);
1899	{'BIT STRING',CType,_} ->
1900	    normalize_bitstring(S,Value,CType);
1901	{'OCTET STRING',CType,_} ->
1902	    normalize_octetstring(S,Value,CType);
1903	{'NULL',_CType,_} ->
1904	    %%normalize_null(Value);
1905	    'NULL';
1906	{'OBJECT IDENTIFIER',_,_} ->
1907	    normalize_objectidentifier(S,Value);
1908	{'ObjectDescriptor',_,_} ->
1909	    normalize_objectdescriptor(Value);
1910	{'REAL',_,_} ->
1911	    normalize_real(Value);
1912	{'ENUMERATED',CType,_} ->
1913	    normalize_enumerated(Value,CType);
1914	{'CHOICE',CType,NewNameList} ->
1915	    normalize_choice(S,Value,CType,NewNameList);
1916	{'SEQUENCE',CType,NewNameList} ->
1917	    normalize_sequence(S,Value,CType,NewNameList);
1918	{'SEQUENCE OF',CType,NewNameList} ->
1919	    normalize_seqof(S,Value,CType,NewNameList);
1920	{'SET',CType,NewNameList} ->
1921	    normalize_set(S,Value,CType,NewNameList);
1922	{'SET OF',CType,NewNameList} ->
1923	    normalize_setof(S,Value,CType,NewNameList);
1924	{restrictedstring,CType,_} ->
1925	    normalize_restrictedstring(S,Value,CType);
1926	_ ->
1927	    io:format("WARNING: could not check default value ~p~n",[Value]),
1928	    Value
1929    end;
1930normalize_value(S,Type,Val,NameList) ->
1931    normalize_value(S,Type,{'DEFAULT',Val},NameList).
1932
1933normalize_boolean(S,{Name,Bool},CType) when atom(Name) ->
1934    normalize_boolean(S,Bool,CType);
1935normalize_boolean(_,true,_) ->
1936    true;
1937normalize_boolean(_,false,_) ->
1938    false;
1939normalize_boolean(S,Bool=#'Externalvaluereference'{},CType) ->
1940    get_normalized_value(S,Bool,CType,fun normalize_boolean/3,[]);
1941normalize_boolean(_,Other,_) ->
1942    throw({error,{asn1,{'invalid default value',Other}}}).
1943
1944normalize_integer(_S,Int,_) when integer(Int) ->
1945    Int;
1946normalize_integer(_S,{Name,Int},_) when atom(Name),integer(Int) ->
1947    Int;
1948normalize_integer(S,{Name,Int=#'Externalvaluereference'{}},
1949		  Type) when atom(Name) ->
1950    normalize_integer(S,Int,Type);
1951normalize_integer(S,Int=#'Externalvaluereference'{value=Name},Type) ->
1952    case Type of
1953	NNL when list(NNL) ->
1954	    case lists:keysearch(Name,1,NNL) of
1955		{value,{Name,Val}} ->
1956		    Val;
1957		false ->
1958		    get_normalized_value(S,Int,Type,
1959					 fun normalize_integer/3,[])
1960	    end;
1961	_ ->
1962	    get_normalized_value(S,Int,Type,fun normalize_integer/3,[])
1963    end;
1964normalize_integer(_,Int,_) ->
1965    exit({'Unknown INTEGER value',Int}).
1966
1967normalize_bitstring(S,Value,Type)->
1968    %% There are four different Erlang formats of BIT STRING:
1969    %% 1 - a list of ones and zeros.
1970    %% 2 - a list of atoms.
1971    %% 3 - as an integer, for instance in hexadecimal form.
1972    %% 4 - as a tuple {Unused, Binary} where Unused is an integer
1973    %%   and tells how many bits of Binary are unused.
1974    %%
1975    %% normalize_bitstring/3 transforms Value according to:
1976    %% A to 3,
1977    %% B to 1,
1978    %% C to 1 or 3
1979    %% D to 2,
1980    %% Value can be on format:
1981    %% A - {hstring, String}, where String is a hexadecimal string.
1982    %% B - {bstring, String}, where String is a string on bit format
1983    %% C - #'Externalvaluereference'{value=V}, where V is a defined value
1984    %% D - list of #'Externalvaluereference', where each value component
1985    %%     is an identifier corresponing to NamedBits in Type.
1986    case Value of
1987	{hstring,String} when list(String) ->
1988	    hstring_to_int(String);
1989	{bstring,String} when list(String) ->
1990	    bstring_to_bitlist(String);
1991	Rec when record(Rec,'Externalvaluereference') ->
1992	    get_normalized_value(S,Value,Type,
1993				 fun normalize_bitstring/3,[]);
1994	RecList when list(RecList) ->
1995	    case Type of
1996		NBL when list(NBL) ->
1997		    F = fun(#'Externalvaluereference'{value=Name}) ->
1998				case lists:keysearch(Name,1,NBL) of
1999				    {value,{Name,_}} ->
2000					Name;
2001				    Other ->
2002					throw({error,Other})
2003				end;
2004			   (Other) ->
2005				throw({error,Other})
2006			end,
2007		    case catch lists:map(F,RecList) of
2008			{error,Reason} ->
2009			    io:format("WARNING: default value not "
2010				      "compatible with type definition ~p~n",
2011				      [Reason]),
2012			    Value;
2013			NewList ->
2014			    NewList
2015		    end;
2016		_ ->
2017		    io:format("WARNING: default value not "
2018			      "compatible with type definition ~p~n",
2019			      [RecList]),
2020		    Value
2021	    end;
2022	{Name,String} when atom(Name) ->
2023	    normalize_bitstring(S,String,Type);
2024	Other ->
2025	    io:format("WARNING: illegal default value ~p~n",[Other]),
2026	    Value
2027    end.
2028
2029hstring_to_int(L) when list(L) ->
2030    hstring_to_int(L,0).
2031hstring_to_int([H|T],Acc) when H >= $A, H =< $F ->
2032    hstring_to_int(T,(Acc bsl 4) + (H - $A + 10) ) ;
2033hstring_to_int([H|T],Acc) when H >= $0, H =< $9 ->
2034    hstring_to_int(T,(Acc bsl 4) + (H - $0));
2035hstring_to_int([],Acc) ->
2036    Acc.
2037
2038bstring_to_bitlist([H|T]) when H == $0; H == $1 ->
2039    [H - $0 | bstring_to_bitlist(T)];
2040bstring_to_bitlist([]) ->
2041    [].
2042
2043%% normalize_octetstring/1 changes representation of input Value to a
2044%% list of octets.
2045%% Format of Value is one of:
2046%% {bstring,String} each element in String corresponds to one bit in an octet
2047%% {hstring,String} each element in String corresponds to one byte in an octet
2048%% #'Externalvaluereference'
2049normalize_octetstring(S,Value,CType) ->
2050    case Value of
2051	{bstring,String} ->
2052	    bstring_to_octetlist(String);
2053	{hstring,String} ->
2054	    hstring_to_octetlist(String);
2055	Rec when record(Rec,'Externalvaluereference') ->
2056	    get_normalized_value(S,Value,CType,
2057				 fun normalize_octetstring/3,[]);
2058	{Name,String} when atom(Name) ->
2059	    normalize_octetstring(S,String,CType);
2060	List when list(List) ->
2061	    %% check if list elements are valid octet values
2062	    lists:map(fun([])-> ok;
2063			 (H)when H > 255->
2064			      io:format("WARNING: not legal octet value ~p in OCTET STRING, ~p~n",[H,List]);
2065			 (_)-> ok
2066		      end, List),
2067	    List;
2068	Other ->
2069	    io:format("WARNING: unknown default value ~p~n",[Other]),
2070	    Value
2071    end.
2072
2073
2074bstring_to_octetlist([]) ->
2075    [];
2076bstring_to_octetlist([H|T]) when H == $0 ; H == $1 ->
2077    bstring_to_octetlist(T,6,[(H - $0) bsl 7]).
2078bstring_to_octetlist([H|T],0,[Hacc|Tacc]) when H == $0; H == $1 ->
2079    bstring_to_octetlist(T, 7, [0,Hacc + (H -$0)| Tacc]);
2080bstring_to_octetlist([H|T],BSL,[Hacc|Tacc]) when H == $0; H == $1 ->
2081    bstring_to_octetlist(T, BSL-1, [Hacc + ((H - $0) bsl BSL)| Tacc]);
2082bstring_to_octetlist([],7,[0|Acc]) ->
2083    lists:reverse(Acc);
2084bstring_to_octetlist([],_,Acc) ->
2085    lists:reverse(Acc).
2086
2087hstring_to_octetlist([]) ->
2088    [];
2089hstring_to_octetlist(L) ->
2090    hstring_to_octetlist(L,4,[]).
2091hstring_to_octetlist([H|T],0,[Hacc|Tacc]) when H >= $A, H =< $F ->
2092    hstring_to_octetlist(T,4,[Hacc + (H - $A + 10)|Tacc]);
2093hstring_to_octetlist([H|T],BSL,Acc) when H >= $A, H =< $F ->
2094    hstring_to_octetlist(T,0,[(H - $A + 10) bsl BSL|Acc]);
2095hstring_to_octetlist([H|T],0,[Hacc|Tacc]) when H >= $0; H =< $9 ->
2096    hstring_to_octetlist(T,4,[Hacc + (H - $0)|Tacc]);
2097hstring_to_octetlist([H|T],BSL,Acc) when H >= $0; H =< $9 ->
2098    hstring_to_octetlist(T,0,[(H - $0) bsl BSL|Acc]);
2099hstring_to_octetlist([],_,Acc) ->
2100    lists:reverse(Acc).
2101
2102normalize_objectidentifier(S,Value) ->
2103    validate_objectidentifier(S,Value,[]).
2104
2105normalize_objectdescriptor(Value) ->
2106    Value.
2107
2108normalize_real(Value) ->
2109    Value.
2110
2111normalize_enumerated(#'Externalvaluereference'{value=V},CType)
2112  when list(CType) ->
2113    normalize_enumerated2(V,CType);
2114normalize_enumerated(Value,CType) when atom(Value),list(CType) ->
2115    normalize_enumerated2(Value,CType);
2116normalize_enumerated({Name,EnumV},CType) when atom(Name) ->
2117    normalize_enumerated(EnumV,CType);
2118normalize_enumerated(Value,{CType1,CType2}) when list(CType1), list(CType2)->
2119    normalize_enumerated(Value,CType1++CType2);
2120normalize_enumerated(V,CType) ->
2121    io:format("WARNING: Enumerated unknown type ~p~n",[CType]),
2122    V.
2123normalize_enumerated2(V,Enum) ->
2124    case lists:keysearch(V,1,Enum) of
2125	{value,{Val,_}} -> Val;
2126	_ ->
2127	    io:format("WARNING: Enumerated value is not correct ~p~n",[V]),
2128	    V
2129    end.
2130
2131normalize_choice(S,{'CHOICE',{C,V}},CType,NameList) when atom(C) ->
2132    Value =
2133	case V of
2134	    Rec when record(Rec,'Externalvaluereference') ->
2135		get_normalized_value(S,V,CType,
2136				     fun normalize_choice/4,
2137				     [NameList]);
2138	    _ -> V
2139	end,
2140    case catch lists:keysearch(C,#'ComponentType'.name,CType) of
2141	{value,#'ComponentType'{typespec=CT,name=Name}} ->
2142	    {C,normalize_value(S,CT,{'DEFAULT',Value},
2143			       [Name|NameList])};
2144	Other ->
2145	    io:format("WARNING: Wrong format of type/value ~p/~p~n",
2146		      [Other,Value]),
2147	    {C,Value}
2148    end;
2149normalize_choice(S,{'DEFAULT',ValueList},CType,NameList) ->
2150    lists:map(fun(X)-> normalize_choice(S,X,CType,NameList) end, ValueList);
2151normalize_choice(S,Val=#'Externalvaluereference'{},CType,NameList) ->
2152    {_,#valuedef{value=V}}=get_referenced_type(S,Val),
2153    normalize_choice(S,{'CHOICE',V},CType,NameList);
2154%    get_normalized_value(S,Val,CType,fun normalize_choice/4,[NameList]);
2155normalize_choice(S,{Name,ChoiceVal},CType,NameList)
2156  when atom(Name) ->
2157    normalize_choice(S,ChoiceVal,CType,NameList).
2158
2159normalize_sequence(S,{Name,Value},Components,NameList)
2160  when atom(Name),list(Value) ->
2161    normalize_sequence(S,Value,Components,NameList);
2162normalize_sequence(S,Value,Components,NameList) ->
2163    normalized_record('SEQUENCE',S,Value,Components,NameList).
2164
2165normalize_set(S,{Name,Value},Components,NameList)
2166  when atom(Name),list(Value) ->
2167    normalized_record('SET',S,Value,Components,NameList);
2168normalize_set(S,Value,Components,NameList) ->
2169    normalized_record('SET',S,Value,Components,NameList).
2170
2171normalized_record(SorS,S,Value,Components,NameList) ->
2172    NewName = list_to_atom(asn1ct_gen:list2name(NameList)),
2173    NoComps = length(Components),
2174    case normalize_seq_or_set(SorS,S,Value,Components,NameList,[]) of
2175	ListOfVals when length(ListOfVals) == NoComps ->
2176	    list_to_tuple([NewName|ListOfVals]);
2177	_ ->
2178	    error({type,{illegal,default,value,Value},S})
2179    end.
2180
2181normalize_seq_or_set(SorS,S,[{Cname,V}|Vs],
2182		     [#'ComponentType'{name=Cname,typespec=TS}|Cs],
2183		     NameList,Acc) ->
2184    NewNameList =
2185	case TS#type.def of
2186	    #'Externaltypereference'{type=TName} ->
2187		[TName];
2188	    _ -> [Cname|NameList]
2189	end,
2190    NVal = normalize_value(S,TS,{'DEFAULT',V},NewNameList),
2191    normalize_seq_or_set(SorS,S,Vs,Cs,NameList,[NVal|Acc]);
2192normalize_seq_or_set(SorS,S,Values=[{_Cname1,_V}|_Vs],
2193		     [#'ComponentType'{prop='OPTIONAL'}|Cs],
2194		     NameList,Acc) ->
2195    normalize_seq_or_set(SorS,S,Values,Cs,NameList,[asn1_NOVALUE|Acc]);
2196normalize_seq_or_set(SorS,S,Values=[{_Cname1,_V}|_Vs],
2197		    [#'ComponentType'{name=Cname2,typespec=TS,
2198				      prop={'DEFAULT',Value}}|Cs],
2199		    NameList,Acc) ->
2200    NewNameList =
2201	case TS#type.def of
2202	    #'Externaltypereference'{type=TName} ->
2203		[TName];
2204	    _ -> [Cname2|NameList]
2205	end,
2206    NVal =  normalize_value(S,TS,{'DEFAULT',Value},NewNameList),
2207    normalize_seq_or_set(SorS,S,Values,Cs,NameList,[NVal|Acc]);
2208normalize_seq_or_set(_SorS,_S,[],[],_,Acc) ->
2209    lists:reverse(Acc);
2210%% If default value is {} ComponentTypes in SEQUENCE are marked DEFAULT
2211%% or OPTIONAL (or the type is defined SEQUENCE{}, which is handled by
2212%% the previous case).
2213normalize_seq_or_set(SorS,S,[],
2214		     [#'ComponentType'{name=Name,typespec=TS,
2215				       prop={'DEFAULT',Value}}|Cs],
2216		     NameList,Acc) ->
2217    NewNameList =
2218	case TS#type.def of
2219	    #'Externaltypereference'{type=TName} ->
2220		[TName];
2221	    _ -> [Name|NameList]
2222	end,
2223    NVal =  normalize_value(S,TS,{'DEFAULT',Value},NewNameList),
2224    normalize_seq_or_set(SorS,S,[],Cs,NameList,[NVal|Acc]);
2225normalize_seq_or_set(SorS,S,[],[#'ComponentType'{prop='OPTIONAL'}|Cs],
2226		     NameList,Acc) ->
2227    normalize_seq_or_set(SorS,S,[],Cs,NameList,[asn1_NOVALUE|Acc]);
2228normalize_seq_or_set(SorS,S,Value=#'Externalvaluereference'{},
2229		     Cs,NameList,Acc) ->
2230    get_normalized_value(S,Value,Cs,fun normalize_seq_or_set/6,
2231			 [SorS,NameList,Acc]);
2232normalize_seq_or_set(_SorS,S,V,_,_,_) ->
2233    error({type,{illegal,default,value,V},S}).
2234
2235normalize_seqof(S,Value,Type,NameList) ->
2236    normalize_s_of('SEQUENCE OF',S,Value,Type,NameList).
2237
2238normalize_setof(S,Value,Type,NameList) ->
2239    normalize_s_of('SET OF',S,Value,Type,NameList).
2240
2241normalize_s_of(SorS,S,Value,Type,NameList) when list(Value) ->
2242    DefValueList = lists:map(fun(X) -> {'DEFAULT',X} end,Value),
2243    Suffix = asn1ct_gen:constructed_suffix(SorS,Type),
2244    Def = Type#type.def,
2245    InnerType = asn1ct_gen:get_inner(Def),
2246    WhatKind = asn1ct_gen:type(InnerType),
2247    NewNameList =
2248	case WhatKind of
2249	    {constructed,bif} ->
2250		[Suffix|NameList];
2251	    #'Externaltypereference'{type=Name} ->
2252		[Name];
2253	    _ -> []
2254	end,
2255    NormFun = 	fun (X) -> normalize_value(S,Type,X,
2256					   NewNameList) end,
2257    case catch lists:map(NormFun, DefValueList) of
2258	List when list(List) ->
2259	    List;
2260	_ ->
2261	    io:format("WARNING: ~p could not handle value ~p~n",
2262		      [SorS,Value]),
2263	    Value
2264    end;
2265normalize_s_of(SorS,S,Value,Type,NameList)
2266  when record(Value,'Externalvaluereference') ->
2267    get_normalized_value(S,Value,Type,fun normalize_s_of/5,
2268			 [SorS,NameList]).
2269%     case catch get_referenced_type(S,Value) of
2270% 	{_,#valuedef{value=V}} ->
2271% 	    normalize_s_of(SorS,S,V,Type);
2272% 	{error,Reason} ->
2273% 	    io:format("WARNING: ~p could not handle value ~p~n",
2274% 		      [SorS,Value]),
2275% 	    Value;
2276% 	{_,NewVal} ->
2277% 	    normalize_s_of(SorS,S,NewVal,Type);
2278% 	_ ->
2279% 	    io:format("WARNING: ~p could not handle value ~p~n",
2280% 		      [SorS,Value]),
2281% 	    Value
2282%     end.
2283
2284
2285%% normalize_restrictedstring handles all format of restricted strings.
2286%% tuple case
2287normalize_restrictedstring(_S,[Int1,Int2],_) when integer(Int1),integer(Int2) ->
2288    {Int1,Int2};
2289%% quadruple case
2290normalize_restrictedstring(_S,[Int1,Int2,Int3,Int4],_) when integer(Int1),
2291							   integer(Int2),
2292							   integer(Int3),
2293							   integer(Int4) ->
2294    {Int1,Int2,Int3,Int4};
2295%% character string list case
2296normalize_restrictedstring(S,[H|T],CType) when list(H);tuple(H) ->
2297    [normalize_restrictedstring(S,H,CType)|normalize_restrictedstring(S,T,CType)];
2298%% character sting case
2299normalize_restrictedstring(_S,CString,_) when list(CString) ->
2300    Fun =
2301	fun(X) ->
2302		if
2303		    $X =< 255, $X >= 0 ->
2304			ok;
2305		    true ->
2306			io:format("WARNING: illegal character in string"
2307				  " ~p~n",[X])
2308		end
2309	end,
2310    lists:foreach(Fun,CString),
2311    CString;
2312%% definedvalue case or argument in a parameterized type
2313normalize_restrictedstring(S,ERef,CType) when record(ERef,'Externalvaluereference') ->
2314    get_normalized_value(S,ERef,CType,
2315			 fun normalize_restrictedstring/3,[]);
2316%%
2317normalize_restrictedstring(S,{Name,Val},CType) when atom(Name) ->
2318    normalize_restrictedstring(S,Val,CType).
2319
2320
2321get_normalized_value(S,Val,Type,Func,AddArg) ->
2322    case catch get_referenced_type(S,Val) of
2323	{_,#valuedef{type=_T,value=V}} ->
2324	    %% should check that Type and T equals
2325	    call_Func(S,V,Type,Func,AddArg);
2326	{error,_} ->
2327	    io:format("WARNING: default value not "
2328		      "comparable ~p~n",[Val]),
2329	    Val;
2330	{_,NewVal} ->
2331	    call_Func(S,NewVal,Type,Func,AddArg);
2332	_ ->
2333	    io:format("WARNING: default value not "
2334		      "comparable ~p~n",[Val]),
2335	    Val
2336    end.
2337
2338call_Func(S,Val,Type,Func,ArgList) ->
2339    case ArgList of
2340	[] ->
2341	    Func(S,Val,Type);
2342	[LastArg] ->
2343	    Func(S,Val,Type,LastArg);
2344	[Arg1,LastArg1] ->
2345	    Func(Arg1,S,Val,Type,LastArg1);
2346	[Arg1,LastArg1,LastArg2] ->
2347	    Func(Arg1,S,Val,Type,LastArg1,LastArg2)
2348    end.
2349
2350
2351get_canonic_type(S,Type,NameList) ->
2352    {InnerType,NewType,NewNameList} =
2353	case Type#type.def of
2354	    Name when atom(Name) ->
2355		{Name,Type,NameList};
2356	    Ref when record(Ref,'Externaltypereference') ->
2357		{_,#typedef{name=Name,typespec=RefedType}} =
2358		    get_referenced_type(S,Ref),
2359		get_canonic_type(S,RefedType,[Name]);
2360	    {Name,T} when atom(Name) ->
2361		{Name,T,NameList};
2362	    Seq when record(Seq,'SEQUENCE') ->
2363		{'SEQUENCE',Seq#'SEQUENCE'.components,NameList};
2364	    Set when record(Set,'SET') ->
2365		{'SET',Set#'SET'.components,NameList}
2366	end,
2367    {asn1ct_gen:unify_if_string(InnerType),NewType,NewNameList}.
2368
2369
2370
2371check_ptype(_S,Type,Ts) when record(Ts,type) ->
2372    %Tag = Ts#type.tag,
2373    %Constr = Ts#type.constraint,
2374    Def = Ts#type.def,
2375    NewDef=
2376	case Def of
2377	    Seq when record(Seq,'SEQUENCE') ->
2378		#newt{type=Seq#'SEQUENCE'{pname=Type#ptypedef.name}};
2379	    Set when record(Set,'SET') ->
2380		#newt{type=Set#'SET'{pname=Type#ptypedef.name}};
2381	    _Other ->
2382		#newt{}
2383	end,
2384    Ts2 = case NewDef of
2385	      #newt{type=unchanged} ->
2386		  Ts;
2387	      #newt{type=TDef}->
2388		  Ts#type{def=TDef}
2389	  end,
2390    Ts2.
2391
2392
2393% check_type(S,Type,ObjSpec={{objectclassname,_},_}) ->
2394%     check_class(S,ObjSpec);
2395check_type(_S,Type,Ts) when record(Type,typedef),
2396			   (Type#typedef.checked==true) ->
2397    Ts;
2398check_type(_S,Type,Ts) when record(Type,typedef),
2399			   (Type#typedef.checked==idle) -> % the check is going on
2400    Ts;
2401check_type(S=#state{recordtopname=TopName},Type,Ts) when record(Ts,type) ->
2402    {Def,Tag,Constr} =
2403	case match_parameters(Ts#type.def,S#state.parameters) of
2404	    #type{constraint=_Ctmp,def=Dtmp} ->
2405		{Dtmp,Ts#type.tag,Ts#type.constraint};
2406	    Dtmp ->
2407		{Dtmp,Ts#type.tag,Ts#type.constraint}
2408	end,
2409    TempNewDef = #newt{type=Def,tag=Tag,constraint=Constr},
2410    TestFun =
2411	fun(Tref) ->
2412		{_,MaybeChoice} = get_referenced_type(S,Tref),
2413		case catch((MaybeChoice#typedef.typespec)#type.def) of
2414		    {'CHOICE',_} ->
2415			maybe_illicit_implicit_tag(choice,Tag);
2416		    'ANY' ->
2417			maybe_illicit_implicit_tag(open_type,Tag);
2418		    'ANY DEFINED BY' ->
2419			maybe_illicit_implicit_tag(open_type,Tag);
2420		    'ASN1_OPEN_TYPE' ->
2421			maybe_illicit_implicit_tag(open_type,Tag);
2422		    _ ->
2423			Tag
2424		end
2425	end,
2426    NewDef=
2427	case Def of
2428	    Ext when record(Ext,'Externaltypereference') ->
2429		{_,RefTypeDef} = get_referenced_type(S,Ext),
2430% 		case RefTypeDef of
2431% 		    Class when record(Class,classdef) ->
2432% 			throw({asn1_class,Class});
2433% 		    _ -> ok
2434% 		end,
2435		case is_class(S,RefTypeDef) of
2436		    true -> throw({asn1_class,RefTypeDef});
2437		    _ -> ok
2438		end,
2439		Ct = TestFun(Ext),
2440		RefType =
2441%case  S#state.erule of
2442%			      ber_bin_v2 ->
2443		    case RefTypeDef#typedef.checked of
2444			true ->
2445			    RefTypeDef#typedef.typespec;
2446			_ ->
2447			    NewRefTypeDef1 = RefTypeDef#typedef{checked=idle},
2448			    asn1_db:dbput(S#state.mname,
2449					  NewRefTypeDef1#typedef.name,NewRefTypeDef1),
2450			    RefType1 =
2451				check_type(S,RefTypeDef,RefTypeDef#typedef.typespec),
2452			    NewRefTypeDef2 =
2453				RefTypeDef#typedef{checked=true,typespec = RefType1},
2454			    asn1_db:dbput(S#state.mname,
2455					  NewRefTypeDef2#typedef.name,NewRefTypeDef2),
2456			    %% update the type and mark as checked
2457			    RefType1
2458		    end,
2459%			      _ -> RefTypeDef#typedef.typespec
2460%			  end,
2461
2462		case asn1ct_gen:prim_bif(asn1ct_gen:get_inner(RefType#type.def)) of
2463		    true ->
2464			%% Here we expand to a built in type and inline it
2465			TempNewDef#newt{
2466			  type=
2467			  RefType#type.def,
2468			  tag=
2469			  merge_tags(Ct,RefType#type.tag),
2470			  constraint=
2471			  merge_constraints(check_constraints(S,Constr),
2472					    RefType#type.constraint)};
2473		    _ ->
2474			%% Here we only expand the tags and keep the ext ref
2475
2476			TempNewDef#newt{
2477			  type=
2478			  check_externaltypereference(S,Ext),
2479			  tag =
2480			  case S#state.erule of
2481			      ber_bin_v2 ->
2482				  merge_tags(Ct,RefType#type.tag);
2483			      _ ->
2484				  Ct
2485			  end
2486			 }
2487		end;
2488	    'ANY' ->
2489		Ct=maybe_illicit_implicit_tag(open_type,Tag),
2490		TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct};
2491	    {'ANY_DEFINED_BY',_} ->
2492		Ct=maybe_illicit_implicit_tag(open_type,Tag),
2493		TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct};
2494	    'INTEGER' ->
2495		check_integer(S,[],Constr),
2496		TempNewDef#newt{tag=
2497				merge_tags(Tag,?TAG_PRIMITIVE(?N_INTEGER))};
2498
2499	    {'INTEGER',NamedNumberList} ->
2500		TempNewDef#newt{type={'INTEGER',check_integer(S,NamedNumberList,Constr)},
2501				tag=
2502				merge_tags(Tag,?TAG_PRIMITIVE(?N_INTEGER))};
2503	    {'BIT STRING',NamedNumberList} ->
2504		NewL = check_bitstring(S,NamedNumberList,Constr),
2505%%		erlang:display({asn1ct_check,NamedNumberList,NewL}),
2506		TempNewDef#newt{type={'BIT STRING',NewL},
2507				tag=
2508				merge_tags(Tag,?TAG_PRIMITIVE(?N_BIT_STRING))};
2509	    'NULL' ->
2510		TempNewDef#newt{tag=
2511				merge_tags(Tag,?TAG_PRIMITIVE(?N_NULL))};
2512	    'OBJECT IDENTIFIER' ->
2513		check_objectidentifier(S,Constr),
2514		TempNewDef#newt{tag=
2515			       merge_tags(Tag,?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER))};
2516	    'ObjectDescriptor' ->
2517		TempNewDef#newt{tag=
2518			       merge_tags(Tag,?TAG_PRIMITIVE(?N_OBJECT_DESCRIPTOR))};
2519	    'EXTERNAL' ->
2520%%		AssociatedType = asn1_db:dbget(S#state.mname,'EXTERNAL'),
2521%%		#newt{type=check_type(S,Type,AssociatedType)};
2522		put(external,unchecked),
2523		TempNewDef#newt{type=
2524				#'Externaltypereference'{module=S#state.mname,
2525							 type='EXTERNAL'},
2526				tag=
2527				merge_tags(Tag,?TAG_CONSTRUCTED(?N_EXTERNAL))};
2528	    {'INSTANCE OF',DefinedObjectClass,Constraint} ->
2529		%% check that DefinedObjectClass is of TYPE-IDENTIFIER class
2530		%% If Constraint is empty make it the general INSTANCE OF type
2531		%% If Constraint is not empty make an inlined type
2532		%% convert INSTANCE OF to the associated type
2533		IOFDef=check_instance_of(S,DefinedObjectClass,Constraint),
2534		TempNewDef#newt{type=IOFDef,
2535				tag=merge_tags(Tag,?TAG_CONSTRUCTED(?N_INSTANCE_OF))};
2536	    {'ENUMERATED',NamedNumberList} ->
2537		TempNewDef#newt{type=
2538				{'ENUMERATED',
2539				 check_enumerated(S,NamedNumberList,Constr)},
2540				tag=
2541				merge_tags(Tag,?TAG_PRIMITIVE(?N_ENUMERATED))};
2542	    'EMBEDDED PDV' ->
2543%		AssociatedType = asn1_db:dbget(S#state.mname,'EMBEDDED PDV'),
2544%		CheckedType = check_type(S,Type,
2545%					 AssociatedType#typedef.typespec),
2546		put(embedded_pdv,unchecked),
2547		TempNewDef#newt{type=
2548				#'Externaltypereference'{module=S#state.mname,
2549							 type='EMBEDDED PDV'},
2550				tag=
2551				merge_tags(Tag,?TAG_CONSTRUCTED(?N_EMBEDDED_PDV))};
2552	    'BOOLEAN'->
2553		check_boolean(S,Constr),
2554		TempNewDef#newt{tag=
2555				merge_tags(Tag,?TAG_PRIMITIVE(?N_BOOLEAN))};
2556	    'OCTET STRING' ->
2557		check_octetstring(S,Constr),
2558		TempNewDef#newt{tag=
2559				merge_tags(Tag,?TAG_PRIMITIVE(?N_OCTET_STRING))};
2560	    'NumericString' ->
2561		check_restrictedstring(S,Def,Constr),
2562		TempNewDef#newt{tag=
2563				merge_tags(Tag,?TAG_PRIMITIVE(?N_NumericString))};
2564	    'TeletexString' ->
2565		check_restrictedstring(S,Def,Constr),
2566		TempNewDef#newt{tag=
2567				merge_tags(Tag,?TAG_PRIMITIVE(?N_TeletexString))};
2568	    'VideotexString' ->
2569		check_restrictedstring(S,Def,Constr),
2570		TempNewDef#newt{tag=
2571				merge_tags(Tag,?TAG_PRIMITIVE(?N_VideotexString))};
2572	    'UTCTime' ->
2573		TempNewDef#newt{tag=
2574				merge_tags(Tag,?TAG_PRIMITIVE(?N_UTCTime))};
2575	    'GeneralizedTime' ->
2576		TempNewDef#newt{tag=
2577				merge_tags(Tag,?TAG_PRIMITIVE(?N_GeneralizedTime))};
2578	    'GraphicString' ->
2579		check_restrictedstring(S,Def,Constr),
2580		TempNewDef#newt{tag=
2581				merge_tags(Tag,?TAG_PRIMITIVE(?N_GraphicString))};
2582	    'VisibleString' ->
2583		check_restrictedstring(S,Def,Constr),
2584		TempNewDef#newt{tag=
2585				merge_tags(Tag,?TAG_PRIMITIVE(?N_VisibleString))};
2586	    'GeneralString' ->
2587		check_restrictedstring(S,Def,Constr),
2588		TempNewDef#newt{tag=
2589				merge_tags(Tag,?TAG_PRIMITIVE(?N_GeneralString))};
2590	    'PrintableString' ->
2591		check_restrictedstring(S,Def,Constr),
2592		TempNewDef#newt{tag=
2593				merge_tags(Tag,?TAG_PRIMITIVE(?N_PrintableString))};
2594	    'IA5String' ->
2595		check_restrictedstring(S,Def,Constr),
2596		TempNewDef#newt{tag=
2597				merge_tags(Tag,?TAG_PRIMITIVE(?N_IA5String))};
2598	    'BMPString' ->
2599		check_restrictedstring(S,Def,Constr),
2600		TempNewDef#newt{tag=
2601				merge_tags(Tag,?TAG_PRIMITIVE(?N_BMPString))};
2602	    'UniversalString' ->
2603		check_restrictedstring(S,Def,Constr),
2604		TempNewDef#newt{tag=
2605				merge_tags(Tag,?TAG_PRIMITIVE(?N_UniversalString))};
2606	    'CHARACTER STRING' ->
2607%		AssociatedType = asn1_db:dbget(S#state.mname,
2608%					       'CHARACTER STRING'),
2609%		CheckedType = check_type(S,Type,
2610%					 AssociatedType#typedef.typespec),
2611		put(character_string,unchecked),
2612		TempNewDef#newt{type=
2613				#'Externaltypereference'{module=S#state.mname,
2614							 type='CHARACTER STRING'},
2615				tag=
2616				merge_tags(Tag,?TAG_CONSTRUCTED(?N_CHARACTER_STRING))};
2617	    Seq when record(Seq,'SEQUENCE') ->
2618		RecordName =
2619		    case TopName of
2620			[] ->
2621			    [Type#typedef.name];
2622			_ ->
2623			    TopName
2624		    end,
2625		{TableCInf,Components} =
2626		    check_sequence(S#state{recordtopname=
2627					   RecordName},
2628					   Type,Seq#'SEQUENCE'.components),
2629		TempNewDef#newt{type=Seq#'SEQUENCE'{tablecinf=TableCInf,
2630					  components=Components},
2631				tag=
2632				merge_tags(Tag,?TAG_CONSTRUCTED(?N_SEQUENCE))};
2633	    {'SEQUENCE OF',Components} ->
2634		TempNewDef#newt{type={'SEQUENCE OF',check_sequenceof(S,Type,Components)},
2635				tag=
2636				merge_tags(Tag,?TAG_CONSTRUCTED(?N_SEQUENCE))};
2637	    {'CHOICE',Components} ->
2638		Ct = maybe_illicit_implicit_tag(choice,Tag),
2639		TempNewDef#newt{type={'CHOICE',check_choice(S,Type,Components)},tag=Ct};
2640	    Set when record(Set,'SET') ->
2641		RecordName=
2642		    case TopName of
2643			[] ->
2644			    [Type#typedef.name];
2645			_ ->
2646			    TopName
2647		    end,
2648		{Sorted,TableCInf,Components} =
2649		    check_set(S#state{recordtopname=RecordName},
2650			      Type,Set#'SET'.components),
2651		TempNewDef#newt{type=Set#'SET'{sorted=Sorted,
2652				     tablecinf=TableCInf,
2653				     components=Components},
2654				tag=
2655				merge_tags(Tag,?TAG_CONSTRUCTED(?N_SET))};
2656	    {'SET OF',Components} ->
2657		TempNewDef#newt{type={'SET OF',check_setof(S,Type,Components)},
2658				tag=
2659				merge_tags(Tag,?TAG_CONSTRUCTED(?N_SET))};
2660	    %% This is a temporary hack until the full Information Obj Spec
2661	    %% in X.681 is supported
2662	    {{typereference,_,'TYPE-IDENTIFIER'},[{typefieldreference,_,'Type'}]} ->
2663		Ct=maybe_illicit_implicit_tag(open_type,Tag),
2664		TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct};
2665
2666	    {#'Externaltypereference'{type='TYPE-IDENTIFIER'},
2667	     [{typefieldreference,_,'Type'}]} ->
2668		Ct=maybe_illicit_implicit_tag(open_type,Tag),
2669		TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct};
2670
2671	    {pt,Ptype,ParaList} ->
2672		%% Ptype might be a parameterized - type, object set or
2673		%% value set. If it isn't a parameterized type notify the
2674		%% calling function.
2675		{_,Ptypedef} = get_referenced_type(S,Ptype),
2676		notify_if_not_ptype(S,Ptypedef),
2677		NewParaList = [match_parameters(TmpParam,S#state.parameters)||
2678				  TmpParam <- ParaList],
2679		Instance = instantiate_ptype(S,Ptypedef,NewParaList),
2680		TempNewDef#newt{type=Instance#type.def,
2681				tag=merge_tags(Tag,Instance#type.tag),
2682				constraint=Instance#type.constraint,
2683				inlined=yes};
2684
2685%	    {ClRef,FieldRefList} when record(ClRef,'Externaltypereference') ->
2686	    OCFT=#'ObjectClassFieldType'{class=ClRef} ->
2687		%% this case occures in a SEQUENCE when
2688		%% the type of the component is a ObjectClassFieldType
2689		ClassSpec = check_class(S,ClRef),
2690		NewTypeDef = maybe_open_type(S,ClassSpec,OCFT,Constr),
2691		InnerTag = get_innertag(S,NewTypeDef),
2692		MergedTag = merge_tags(Tag,InnerTag),
2693		Ct =
2694		    case is_open_type(NewTypeDef) of
2695			true ->
2696			    maybe_illicit_implicit_tag(open_type,MergedTag);
2697			_ ->
2698			    MergedTag
2699		    end,
2700		TempNewDef#newt{type=NewTypeDef,tag=Ct};
2701	    {valueset,Vtype} ->
2702		TempNewDef#newt{type={valueset,check_type(S,Type,Vtype)}};
2703	    Other ->
2704		exit({'cant check' ,Other})
2705	end,
2706    Ts2 = case NewDef of
2707	      #newt{type=unchanged} ->
2708		  Ts#type{def=Def};
2709	      #newt{type=TDef}->
2710		  Ts#type{def=TDef}
2711	  end,
2712    NewTag = case NewDef of
2713		 #newt{tag=unchanged} ->
2714		     Tag;
2715		 #newt{tag=TT} ->
2716		     TT
2717	     end,
2718    T3 = Ts2#type{tag = lists:map(fun(TempTag = #tag{type={default,TTx}}) ->
2719					  TempTag#tag{type=TTx};
2720				     (Else) -> Else end, NewTag)},
2721    T4 = case NewDef of
2722	     #newt{constraint=unchanged} ->
2723		 T3#type{constraint=Constr};
2724	     #newt{constraint=NewConstr} ->
2725		 T3#type{constraint=NewConstr}
2726	 end,
2727    T5 = T4#type{inlined=NewDef#newt.inlined},
2728    T5#type{constraint=check_constraints(S,T5#type.constraint)}.
2729
2730
2731get_innertag(_S,#'ObjectClassFieldType'{type=Type}) ->
2732    case Type of
2733	#type{tag=Tag} -> Tag;
2734	{fixedtypevaluefield,_,#type{tag=Tag}} -> Tag;
2735	{TypeFieldName,_} when atom(TypeFieldName) -> [];
2736	_ -> []
2737    end;
2738get_innertag(_S,_) ->
2739    [].
2740
2741is_class(_S,#classdef{}) ->
2742    true;
2743is_class(S,#typedef{typespec=#type{def=Eref}})
2744  when record(Eref,'Externaltypereference')->
2745    {_,NextDef} = get_referenced_type(S,Eref),
2746    is_class(S,NextDef);
2747is_class(_,_) ->
2748    false.
2749
2750get_class_def(_S,CD=#classdef{}) ->
2751    CD;
2752get_class_def(S,#typedef{typespec=#type{def=Eref}})
2753  when record(Eref,'Externaltypereference') ->
2754    {_,NextDef} = get_referenced_type(S,Eref),
2755    get_class_def(S,NextDef).
2756
2757maybe_illicit_implicit_tag(Kind,Tag) ->
2758    case Tag of
2759	[#tag{type='IMPLICIT'}|_T] ->
2760	    throw({error,{asn1,{implicit_tag_before,Kind}}});
2761	[ChTag = #tag{type={default,_}}|T] ->
2762	    case Kind of
2763		open_type ->
2764		    [ChTag#tag{type='EXPLICIT',form=32}|T]; %X.680 30.6c, X.690 8.14.2
2765		choice ->
2766		    [ChTag#tag{type='EXPLICIT',form=32}|T] % X.680 28.6 c, 30.6c
2767	    end;
2768	_ ->
2769	    Tag % unchanged
2770    end.
2771
2772%% maybe_open_type/2 -> {ClassSpec,FieldRefList} | 'ASN1_OPEN_TYPE'
2773%% if the FieldRefList points out a typefield and the class don't have
2774%% any UNIQUE field, so that a component relation constraint cannot specify
2775%% the type of a typefield, return 'ASN1_OPEN_TYPE', otherwise return
2776%% {ClassSpec,FieldRefList}.
2777maybe_open_type(S,ClassSpec=#objectclass{fields=Fs},
2778		OCFT=#'ObjectClassFieldType'{fieldname=FieldRefList},
2779		Constr) ->
2780    Type = get_ObjectClassFieldType(S,Fs,FieldRefList),
2781    FieldNames=get_referenced_fieldname(FieldRefList),
2782    case lists:last(FieldRefList) of
2783	{valuefieldreference,_} ->
2784	    OCFT#'ObjectClassFieldType'{class=ClassSpec,
2785					fieldname=FieldNames,
2786					type=Type};
2787	{typefieldreference,_} ->
2788	    case {catch get_unique_fieldname(#classdef{typespec=ClassSpec}),
2789		  asn1ct_gen:get_constraint(Constr,componentrelation)}of
2790		{Tuple,_} when tuple(Tuple) ->
2791		    OCFT#'ObjectClassFieldType'{class=ClassSpec,
2792						fieldname=FieldNames,
2793						type='ASN1_OPEN_TYPE'};
2794		{_,no} ->
2795		    OCFT#'ObjectClassFieldType'{class=ClassSpec,
2796						fieldname=FieldNames,
2797						type='ASN1_OPEN_TYPE'};
2798		_ ->
2799		    OCFT#'ObjectClassFieldType'{class=ClassSpec,
2800						fieldname=FieldNames,
2801						type=Type}
2802	    end
2803    end.
2804
2805is_open_type(#'ObjectClassFieldType'{type='ASN1_OPEN_TYPE'}) ->
2806    true;
2807is_open_type(#'ObjectClassFieldType'{}) ->
2808    false.
2809
2810
2811notify_if_not_ptype(S,#pvaluesetdef{type=Type}) ->
2812    case Type#type.def of
2813	Ref when record(Ref,'Externaltypereference') ->
2814	    case get_referenced_type(S,Ref) of
2815		{_,#classdef{}} ->
2816		    throw(pobjectsetdef);
2817		{_,#typedef{}} ->
2818		    throw(pvalueset)
2819	    end;
2820	T when record(T,type) -> % this must be a value set
2821	    throw(pvalueset)
2822    end;
2823notify_if_not_ptype(_S,#ptypedef{}) ->
2824    ok.
2825
2826% fix me
2827instantiate_ptype(S,Ptypedef,ParaList) ->
2828    #ptypedef{args=Args,typespec=Type} = Ptypedef,
2829%    Args = get_pt_args(Ptypedef),
2830%    Type = get_pt_spec(Ptypedef),
2831    MatchedArgs = match_args(Args, ParaList, []),
2832    NewS = S#state{type=Type,parameters=MatchedArgs,abscomppath=[]},
2833    %The abscomppath must be empty since a table constraint in a
2834    %parameterized type only can refer to components within the type
2835    check_type(NewS, Ptypedef, Type).
2836
2837get_pt_args(#ptypedef{args=Args}) ->
2838    Args;
2839get_pt_args(#pvaluesetdef{args=Args}) ->
2840    Args;
2841get_pt_args(#pvaluedef{args=Args}) ->
2842    Args;
2843get_pt_args(#pobjectdef{args=Args}) ->
2844    Args;
2845get_pt_args(#pobjectsetdef{args=Args}) ->
2846    Args.
2847
2848get_pt_spec(#ptypedef{typespec=Type}) ->
2849    Type;
2850get_pt_spec(#pvaluedef{value=Value}) ->
2851    Value;
2852get_pt_spec(#pvaluesetdef{valueset=VS}) ->
2853    VS;
2854get_pt_spec(#pobjectdef{def=Def}) ->
2855    Def;
2856get_pt_spec(#pobjectsetdef{def=Def}) ->
2857    Def.
2858
2859
2860
2861match_args([FormArg|Ft], [ActArg|At], Acc) ->
2862    match_args(Ft, At, [{FormArg,ActArg}|Acc]);
2863match_args([], [], Acc) ->
2864    lists:reverse(Acc);
2865match_args(_, _, _) ->
2866    throw({error,{asn1,{wrong_number_of_arguments}}}).
2867
2868check_constraints(S,C) when list(C) ->
2869    check_constraints(S, C, []);
2870check_constraints(S,C) when record(C,constraint) ->
2871    check_constraints(S, C#constraint.c, []).
2872
2873
2874resolv_tuple_or_list(S,List) when list(List) ->
2875    lists:map(fun(X)->resolv_value(S,X) end, List);
2876resolv_tuple_or_list(S,{Lb,Ub}) ->
2877    {resolv_value(S,Lb),resolv_value(S,Ub)}.
2878
2879%%%-----------------------------------------
2880%% If the constraint value is a defined value the valuename
2881%% is replaced by the actual value
2882%%
2883resolv_value(S,Val) ->
2884    case match_parameters(Val, S#state.parameters) of
2885	Id -> % unchanged
2886	    resolv_value1(S,Id);
2887	Other ->
2888	    resolv_value(S,Other)
2889    end.
2890
2891resolv_value1(S = #state{mname=M,inputmodules=InpMods},
2892	      V=#'Externalvaluereference'{pos=Pos,module=ExtM,value=Name}) ->
2893    case ExtM of
2894	M -> resolv_value2(S,M,Name,Pos);
2895	_ ->
2896	    case lists:member(ExtM,InpMods) of
2897		true ->
2898		    resolv_value2(S,M,Name,Pos);
2899		false ->
2900		    V
2901	    end
2902    end;
2903resolv_value1(S,{gt,V}) ->
2904    case V of
2905	Int when integer(Int) ->
2906	    V + 1;
2907	#valuedef{value=Int} ->
2908	    1 + resolv_value(S,Int);
2909	Other ->
2910	    throw({error,{asn1,{undefined_type_or_value,Other}}})
2911    end;
2912resolv_value1(S,{lt,V}) ->
2913    case V of
2914	Int when integer(Int) ->
2915	    V - 1;
2916	#valuedef{value=Int} ->
2917	    resolv_value(S,Int) - 1;
2918	Other ->
2919	    throw({error,{asn1,{undefined_type_or_value,Other}}})
2920    end;
2921resolv_value1(S,{'ValueFromObject',{object,Object},[{valuefieldreference,
2922						     FieldName}]}) ->
2923    %% FieldName can hold either a fixed-type value or a variable-type value
2924    %% Object is a DefinedObject, i.e. a #'Externaltypereference'
2925    {_,ObjTDef} = get_referenced_type(S,Object),
2926    TS = check_object(S,ObjTDef,ObjTDef#typedef.typespec),
2927    {_,_,Components} = TS#'Object'.def,
2928    case lists:keysearch(FieldName,1,Components) of
2929	{value,{_,#valuedef{value=Val}}} ->
2930	    Val;
2931	_ ->
2932	    error({value,"illegal value in constraint",S})
2933    end;
2934% resolv_value1(S,{'ValueFromObject',{po,Object,Params},FieldName}) ->
2935%     %% FieldName can hold either a fixed-type value or a variable-type value
2936%     %% Object is a ParameterizedObject
2937resolv_value1(_,V) ->
2938    V.
2939
2940resolv_value2(S,ModuleName,Name,Pos) ->
2941    case asn1_db:dbget(ModuleName,Name) of
2942	undefined ->
2943	    case imported(S,Name) of
2944		{ok,Imodule} ->
2945		    {_,V2} = get_referenced(S,Imodule,Name,Pos),
2946		    V2#valuedef.value;
2947		_  ->
2948		    throw({error,{asn1,{undefined_type_or_value,Name}}})
2949	    end;
2950	Val ->
2951	    Val#valuedef.value
2952    end.
2953
2954check_constraints(S,[{'ContainedSubtype',Type} | Rest], Acc) ->
2955    {_,CTDef} = get_referenced_type(S,Type#type.def),
2956    CType = check_type(S,S#state.tname,CTDef#typedef.typespec),
2957    check_constraints(S,Rest,CType#type.constraint ++ Acc);
2958check_constraints(S,[C | Rest], Acc) ->
2959    check_constraints(S,Rest,[check_constraint(S,C) | Acc]);
2960check_constraints(S,[],Acc) ->
2961%    io:format("Acc: ~p~n",[Acc]),
2962    C = constraint_merge(S,lists:reverse(Acc)),
2963%    io:format("C: ~p~n",[C]),
2964    lists:flatten(C).
2965
2966
2967range_check(F={FixV,FixV}) ->
2968%    FixV;
2969    F;
2970range_check(VR={Lb,Ub}) when Lb < Ub ->
2971    VR;
2972range_check(Err={_,_}) ->
2973    throw({error,{asn1,{illegal_size_constraint,Err}}});
2974range_check(Value) ->
2975    Value.
2976
2977check_constraint(S,Ext) when record(Ext,'Externaltypereference') ->
2978    check_externaltypereference(S,Ext);
2979
2980
2981check_constraint(S,{'SizeConstraint',{Lb,Ub}})
2982  when list(Lb);tuple(Lb),size(Lb)==2 ->
2983    case Lb of
2984	#'Externalvaluereference'{} ->
2985	    check_constraint(S,{'SizeConstraint',{resolv_value(S,Lb),Ub}});
2986	_ ->
2987	    NewLb = range_check(resolv_tuple_or_list(S,Lb)),
2988	    NewUb = range_check(resolv_tuple_or_list(S,Ub)),
2989	    {'SizeConstraint',{NewLb,NewUb}}
2990    end;
2991check_constraint(S,{'SizeConstraint',{Lb,Ub}}) ->
2992    case {resolv_value(S,Lb),resolv_value(S,Ub)} of
2993	{FixV,FixV} ->
2994	    {'SizeConstraint',FixV};
2995	{Low,High} when Low < High ->
2996	    {'SizeConstraint',{Low,High}};
2997	Err ->
2998	    throw({error,{asn1,{illegal_size_constraint,Err}}})
2999    end;
3000check_constraint(S,{'SizeConstraint',Lb}) ->
3001    {'SizeConstraint',resolv_value(S,Lb)};
3002
3003check_constraint(S,{'SingleValue', L}) when list(L) ->
3004    F = fun(A) -> resolv_value(S,A) end,
3005    {'SingleValue',lists:map(F,L)};
3006
3007check_constraint(S,{'SingleValue', V}) when integer(V) ->
3008    Val = resolv_value(S,V),
3009%%    [{'SingleValue',Val},{'ValueRange',{Val,Val}}]; % Why adding value range?
3010    {'SingleValue',Val};
3011check_constraint(S,{'SingleValue', V}) ->
3012    {'SingleValue',resolv_value(S,V)};
3013
3014check_constraint(S,{'ValueRange', {Lb, Ub}}) ->
3015    {'ValueRange',{resolv_value(S,Lb),resolv_value(S,Ub)}};
3016
3017%%check_constraint(S,{'ContainedSubtype',Type}) ->
3018%%    #typedef{typespec=TSpec} =
3019%%	check_type(S,S#state.tname,get_referenced_type(S,Type#type.def)),
3020%%    [C] = TSpec#type.constraint,
3021%%    C;
3022
3023check_constraint(S,{valueset,Type}) ->
3024    {valueset,check_type(S,S#state.tname,Type)};
3025
3026check_constraint(S,{simpletable,Type}) ->
3027    OSName = (Type#type.def)#'Externaltypereference'.type,
3028    C = match_parameters(Type#type.def,S#state.parameters),
3029    case C of
3030	#'Externaltypereference'{} ->
3031	     Type#type{def=check_externaltypereference(S,C)},
3032	    {simpletable,OSName};
3033	_ ->
3034	    check_type(S,S#state.tname,Type),
3035	    {simpletable,OSName}
3036    end;
3037
3038check_constraint(S,{componentrelation,{objectset,Opos,Objset},Id}) ->
3039    %% Objset is an 'Externaltypereference' record, since Objset is
3040    %% a DefinedObjectSet.
3041    RealObjset = match_parameters(Objset,S#state.parameters),
3042    Ext = check_externaltypereference(S,RealObjset),
3043    {componentrelation,{objectset,Opos,Ext},Id};
3044
3045check_constraint(S,Type) when record(Type,type) ->
3046    #type{def=Def} = check_type(S,S#state.tname,Type),
3047    Def;
3048
3049check_constraint(S,C) when list(C) ->
3050    lists:map(fun(X)->check_constraint(S,X) end,C);
3051% else keep the constraint unchanged
3052check_constraint(_S,Any) ->
3053%    io:format("Constraint = ~p~n",[Any]),
3054    Any.
3055
3056%% constraint_merge/2
3057%% Compute the intersection of the outermost level of the constraint list.
3058%% See Dubuisson second paragraph and fotnote on page 285.
3059%% If constraints with extension are included in combined constraints. The
3060%% resulting combination will have the extension of the last constraint. Thus,
3061%% there will be no extension if the last constraint is without extension.
3062%% The rootset of all constraints are considered in the "outermoust
3063%% intersection". See section 13.1.2 in Dubuisson.
3064constraint_merge(_S,C=[H])when tuple(H) ->
3065    C;
3066constraint_merge(_S,[]) ->
3067    [];
3068constraint_merge(S,C) ->
3069    %% skip all extension but the last
3070    C1 = filter_extensions(C),
3071    %% perform all internal level intersections, intersections first
3072    %% since they have precedence over unions
3073    C2 = lists:map(fun(X)when list(X)->constraint_intersection(S,X);
3074		      (X) -> X end,
3075		   C1),
3076    %% perform all internal level unions
3077    C3 = lists:map(fun(X)when list(X)->constraint_union(S,X);
3078		      (X) -> X end,
3079		   C2),
3080
3081    %% now get intersection of the outermost level
3082    %% get the least common single value constraint
3083    SVs = get_constraints(C3,'SingleValue'),
3084    CombSV = intersection_of_sv(S,SVs),
3085    %% get the least common value range constraint
3086    VRs = get_constraints(C3,'ValueRange'),
3087    CombVR = intersection_of_vr(S,VRs),
3088    %% get the least common size constraint
3089    SZs = get_constraints(C3,'SizeConstraint'),
3090    CombSZ = intersection_of_size(S,SZs),
3091    CminusSVs=ordsets:subtract(ordsets:from_list(C3),ordsets:from_list(SVs)),
3092    % CminusSVsVRs = ordsets:subtract(ordsets:from_list(CminusSVs),
3093% 				    ordsets:from_list(VRs)),
3094    RestC = ordsets:subtract(ordsets:from_list(CminusSVs),
3095			     ordsets:from_list(SZs)),
3096    %% get the least common combined constraint. That is the union of each
3097    %% deep costraint and merge of single value and value range constraints
3098    combine_constraints(S,CombSV,CombVR,CombSZ++RestC).
3099
3100%% constraint_union(S,C) takes a list of constraints as input and
3101%% merge them to a union. Unions are performed when two
3102%% constraints is found with an atom union between.
3103%% The list may be nested. Fix that later !!!
3104constraint_union(_S,[]) ->
3105    [];
3106constraint_union(_S,C=[_E]) ->
3107    C;
3108constraint_union(S,C) when list(C) ->
3109    case lists:member(union,C) of
3110	true ->
3111	    constraint_union1(S,C,[]);
3112	_ ->
3113	    C
3114    end;
3115%     SV = get_constraints(C,'SingleValue'),
3116%     SV1 = constraint_union_sv(S,SV),
3117%     VR = get_constraints(C,'ValueRange'),
3118%     VR1 = constraint_union_vr(VR),
3119%     RestC = ordsets:filter(fun({'SingleValue',_})->false;
3120% 			      ({'ValueRange',_})->false;
3121% 			      (_) -> true end,ordsets:from_list(C)),
3122%     SV1++VR1++RestC;
3123constraint_union(_S,C) ->
3124    [C].
3125
3126constraint_union1(S,[A={'ValueRange',_},union,B={'ValueRange',_}|Rest],Acc) ->
3127    AunionB = constraint_union_vr([A,B]),
3128    constraint_union1(S,Rest,AunionB++Acc);
3129constraint_union1(S,[A={'SingleValue',_},union,B={'SingleValue',_}|Rest],Acc) ->
3130    AunionB = constraint_union_sv(S,[A,B]),
3131    constraint_union1(S,Rest,AunionB++Acc);
3132constraint_union1(S,[A={'SingleValue',_},union,B={'ValueRange',_}|Rest],Acc) ->
3133    AunionB = union_sv_vr(S,A,B),
3134    constraint_union1(S,Rest,AunionB++Acc);
3135constraint_union1(S,[A={'ValueRange',_},union,B={'SingleValue',_}|Rest],Acc) ->
3136    AunionB = union_sv_vr(S,B,A),
3137    constraint_union1(S,Rest,AunionB++Acc);
3138constraint_union1(S,[union|Rest],Acc) -> %skip when unsupported constraints
3139    constraint_union1(S,Rest,Acc);
3140constraint_union1(S,[A|Rest],Acc) ->
3141    constraint_union1(S,Rest,[A|Acc]);
3142constraint_union1(_S,[],Acc) ->
3143    lists:reverse(Acc).
3144
3145constraint_union_sv(_S,SV) ->
3146    Values=lists:map(fun({_,V})->V end,SV),
3147    case ordsets:from_list(Values) of
3148	[] -> [];
3149	[N] -> [{'SingleValue',N}];
3150	L -> [{'SingleValue',L}]
3151    end.
3152
3153%% REMOVE????
3154%%constraint_union(S,VR,'ValueRange') ->
3155%%    constraint_union_vr(VR).
3156
3157%% constraint_union_vr(VR)
3158%% VR = [{'ValueRange',{Lb,Ub}},...]
3159%% Lb = 'MIN' | integer()
3160%% Ub = 'MAX' | integer()
3161%% Returns if possible only one ValueRange tuple with a range that
3162%% is a union of all ranges in VR.
3163constraint_union_vr(VR) ->
3164    %% Sort VR by Lb in first hand and by Ub in second hand
3165    Fun=fun({_,{'MIN',_B1}},{_,{A2,_B2}}) when integer(A2)->true;
3166	   ({_,{A1,_B1}},{_,{'MAX',_B2}}) when integer(A1) -> true;
3167	   ({_,{A1,_B1}},{_,{A2,_B2}}) when integer(A1),integer(A2),A1<A2 -> true;
3168	   ({_,{A,B1}},{_,{A,B2}}) when B1=<B2->true;
3169	   (_,_)->false end,
3170    constraint_union_vr(lists:usort(Fun,VR),[]).
3171
3172constraint_union_vr([],Acc) ->
3173    lists:reverse(Acc);
3174constraint_union_vr([C|Rest],[]) ->
3175    constraint_union_vr(Rest,[C]);
3176constraint_union_vr([{_,{Lb,Ub2}}|Rest],[{_,{Lb,_Ub1}}|Acc]) -> %Ub2 > Ub1
3177    constraint_union_vr(Rest,[{'ValueRange',{Lb,Ub2}}|Acc]);
3178constraint_union_vr([{_,{_,Ub}}|Rest],A=[{_,{_,Ub}}|_Acc]) ->
3179    constraint_union_vr(Rest,A);
3180constraint_union_vr([{_,{Lb2,Ub2}}|Rest],[{_,{Lb1,Ub1}}|Acc]) when Lb2=<Ub1,
3181								   Ub2>Ub1->
3182    constraint_union_vr(Rest,[{'ValueRange',{Lb1,Ub2}}|Acc]);
3183constraint_union_vr([{_,{_,Ub2}}|Rest],A=[{_,{_,Ub1}}|_Acc]) when Ub2=<Ub1->
3184    constraint_union_vr(Rest,A);
3185constraint_union_vr([VR|Rest],Acc) ->
3186    constraint_union_vr(Rest,[VR|Acc]).
3187
3188union_sv_vr(_S,[],B) ->
3189    [B];
3190union_sv_vr(_S,A,[]) ->
3191    [A];
3192union_sv_vr(_S,C1={'SingleValue',SV},C2={'ValueRange',VR={Lb,Ub}})
3193  when integer(SV) ->
3194    case is_int_in_vr(SV,C2) of
3195	true -> [C2];
3196	_ ->
3197	    case VR of
3198		{'MIN',Ub} when SV==Ub+1 -> [{'ValueRange',{'MIN',SV}}];
3199		{Lb,'MAX'} when SV==Lb-1 -> [{'ValueRange',{SV,'MAX'}}];
3200		{Lb,Ub} when SV==Ub+1 -> [{'ValueRange',{Lb,SV}}];
3201		{Lb,Ub} when SV==Lb-1 -> [{'ValueRange',{SV,Ub}}];
3202		_ ->
3203		    [C1,C2]
3204	    end
3205    end;
3206union_sv_vr(_S,C1={'SingleValue',SV},C2={'ValueRange',{_Lb,_Ub}})
3207  when list(SV) ->
3208    case lists:filter(fun(X)->is_int_in_vr(X,C2) end,SV) of
3209	[] -> [C2];
3210	L ->
3211	    case expand_vr(L,C2) of
3212		{[],C3} -> [C3];
3213		{L,C2} -> [C1,C2];
3214		{[Val],C3} -> [{'SingleValue',Val},C3];
3215		{L2,C3} -> [{'SingleValue',L2},C3]
3216	    end
3217    end.
3218
3219expand_vr(L,VR={_,{Lb,Ub}}) ->
3220    case lower_Lb(L,Lb) of
3221	false ->
3222	    case higher_Ub(L,Ub) of
3223		false ->
3224		    {L,VR};
3225		{L1,UbNew} ->
3226		    expand_vr(L1,{'ValueRange',{Lb,UbNew}})
3227	    end;
3228	{L1,LbNew} ->
3229	    expand_vr(L1,{'ValueRange',{LbNew,Ub}})
3230    end.
3231
3232lower_Lb(_,'MIN') ->
3233    false;
3234lower_Lb(L,Lb) ->
3235    remove_val_from_list(Lb - 1,L).
3236
3237higher_Ub(_,'MAX') ->
3238    false;
3239higher_Ub(L,Ub) ->
3240    remove_val_from_list(Ub + 1,L).
3241
3242remove_val_from_list(List,Val) ->
3243    case lists:member(Val,List) of
3244	true ->
3245	    {lists:delete(Val,List),Val};
3246	false ->
3247	    false
3248    end.
3249
3250%% get_constraints/2
3251%% Arguments are a list of constraints, which has the format {key,value},
3252%% and a constraint type
3253%% Returns a list of constraints only of the requested type or the atom
3254%% 'no' if no such constraints were found
3255get_constraints(L=[{CType,_}],CType) ->
3256    L;
3257get_constraints(C,CType) ->
3258   keysearch_allwithkey(CType,1,C).
3259
3260%% keysearch_allwithkey(Key,Ix,L)
3261%% Types:
3262%% Key = atom()
3263%% Ix = integer()
3264%% L  = [TwoTuple]
3265%% TwoTuple = [{atom(),term()}|...]
3266%% Returns a List that contains all
3267%% elements from L that has a key Key as element Ix
3268keysearch_allwithkey(Key,Ix,L) ->
3269    lists:filter(fun(X) when tuple(X) ->
3270			 case element(Ix,X) of
3271			     Key -> true;
3272			     _ -> false
3273			 end;
3274		    (_) -> false
3275		 end, L).
3276
3277
3278%% filter_extensions(C)
3279%% takes a list of constraints as input and
3280%% returns a list with the intersection of all extension roots
3281%% and only the extension of the last constraint kept if any
3282%% extension in the last constraint
3283filter_extensions([]) ->
3284    [];
3285filter_extensions(C=[_H]) ->
3286    C;
3287filter_extensions(C) when list(C) ->
3288    filter_extensions(C,[]).
3289
3290filter_extensions([C],Acc) ->
3291    lists:reverse([C|Acc]);
3292filter_extensions([{C,_E},H2|T],Acc) when tuple(C) ->
3293    filter_extensions([H2|T],[C|Acc]);
3294filter_extensions([{'SizeConstraint',{A,_B}},H2|T],Acc)
3295  when list(A);tuple(A) ->
3296    filter_extensions([H2|T],[{'SizeConstraint',A}|Acc]);
3297filter_extensions([H1,H2|T],Acc) ->
3298    filter_extensions([H2|T],[H1|Acc]).
3299
3300%% constraint_intersection(S,C) takes a list of constraints as input and
3301%% performs intersections. Intersecions are performed when an
3302%% atom intersection is found between two constraints.
3303%% The list may be nested. Fix that later !!!
3304constraint_intersection(_S,[]) ->
3305    [];
3306constraint_intersection(_S,C=[_E]) ->
3307    C;
3308constraint_intersection(S,C) when list(C) ->
3309%    io:format("constraint_intersection: ~p~n",[C]),
3310    case lists:member(intersection,C) of
3311	true ->
3312	    constraint_intersection1(S,C,[]);
3313	_ ->
3314	    C
3315    end;
3316constraint_intersection(_S,C) ->
3317    [C].
3318
3319constraint_intersection1(S,[A,intersection,B|Rest],Acc) ->
3320    AisecB = c_intersect(S,A,B),
3321    constraint_intersection1(S,Rest,AisecB++Acc);
3322constraint_intersection1(S,[A|Rest],Acc) ->
3323    constraint_intersection1(S,Rest,[A|Acc]);
3324constraint_intersection1(_,[],Acc) ->
3325    lists:reverse(Acc).
3326
3327c_intersect(S,C1={'SingleValue',_},C2={'SingleValue',_}) ->
3328    intersection_of_sv(S,[C1,C2]);
3329c_intersect(S,C1={'ValueRange',_},C2={'ValueRange',_}) ->
3330    intersection_of_vr(S,[C1,C2]);
3331c_intersect(S,C1={'ValueRange',_},C2={'SingleValue',_}) ->
3332    intersection_sv_vr(S,[C2],[C1]);
3333c_intersect(S,C1={'SingleValue',_},C2={'ValueRange',_}) ->
3334    intersection_sv_vr(S,[C1],[C2]);
3335c_intersect(_S,C1,C2) ->
3336    [C1,C2].
3337
3338%% combine_constraints(S,SV,VR,CComb)
3339%% Types:
3340%% S = record(state,S)
3341%% SV = [] | [SVC]
3342%% VR = [] | [VRC]
3343%% CComb = [] | [Lists]
3344%% SVC = {'SingleValue',integer()} | {'SingleValue',[integer(),...]}
3345%% VRC = {'ValueRange',{Lb,Ub}}
3346%% Lists = List of lists containing any constraint combination
3347%% Lb = 'MIN' | integer()
3348%% Ub = 'MAX' | integer()
3349%% Returns a combination of the least common constraint among SV,VR and all
3350%% elements in CComb
3351combine_constraints(_S,[],VR,CComb) ->
3352    VR ++ CComb;
3353%    combine_combined_cnstr(S,VR,CComb);
3354combine_constraints(_S,SV,[],CComb) ->
3355    SV ++ CComb;
3356%    combine_combined_cnstr(S,SV,CComb);
3357combine_constraints(S,SV,VR,CComb) ->
3358    C=intersection_sv_vr(S,SV,VR),
3359    C ++ CComb.
3360%    combine_combined_cnstr(S,C,CComb).
3361
3362intersection_sv_vr(_,[],_VR) ->
3363    [];
3364intersection_sv_vr(_,_SV,[]) ->
3365    [];
3366intersection_sv_vr(_S,[C1={'SingleValue',SV}],[C2={'ValueRange',{_Lb,_Ub}}])
3367  when integer(SV) ->
3368    case is_int_in_vr(SV,C2) of
3369	true -> [C1];
3370	_ -> %%error({type,{"asn1 illegal constraint",C1,C2},S})
3371	    throw({error,{"asn1 illegal constraint",C1,C2}})
3372    end;
3373intersection_sv_vr(_S,[C1={'SingleValue',SV}],[C2])
3374  when list(SV) ->
3375    case lists:filter(fun(X)->is_int_in_vr(X,C2) end,SV) of
3376	[] ->
3377	    %%error({type,{"asn1 illegal constraint",C1,C2},S});
3378	    throw({error,{"asn1 illegal constraint",C1,C2}});
3379	[V] -> [{'SingleValue',V}];
3380	L -> [{'SingleValue',L}]
3381    end.
3382
3383
3384
3385intersection_of_size(_,[]) ->
3386    [];
3387intersection_of_size(_,C=[_SZ]) ->
3388    C;
3389intersection_of_size(S,[SZ,SZ|Rest]) ->
3390    intersection_of_size(S,[SZ|Rest]);
3391intersection_of_size(S,C=[C1={_,Int},{_,Range}|Rest])
3392  when integer(Int),tuple(Range) ->
3393    case Range of
3394	{Lb,Ub} when Int >= Lb,
3395		     Int =< Ub ->
3396	    intersection_of_size(S,[C1|Rest]);
3397	_ ->
3398	    throw({error,{asn1,{illegal_size_constraint,C}}})
3399    end;
3400intersection_of_size(S,[C1={_,Range},C2={_,Int}|Rest])
3401  when integer(Int),tuple(Range) ->
3402    intersection_of_size(S,[C2,C1|Rest]);
3403intersection_of_size(S,[{_,{Lb1,Ub1}},{_,{Lb2,Ub2}}|Rest]) ->
3404    Lb=greatest_LB(ordsets:from_list([Lb1,Lb2])),
3405    Ub=smallest_UB(ordsets:from_list([Ub1,Ub2])),
3406    intersection_of_size(S,[{'SizeConstraint',{Lb,Ub}}|Rest]);
3407intersection_of_size(_,SZ) ->
3408    throw({error,{asn1,{illegal_size_constraint,SZ}}}).
3409
3410intersection_of_vr(_,[]) ->
3411    [];
3412intersection_of_vr(_,VR=[_C]) ->
3413    VR;
3414intersection_of_vr(S,[{_,{Lb1,Ub1}},{_,{Lb2,Ub2}}|Rest]) ->
3415    Lb=greatest_LB(ordsets:from_list([Lb1,Lb2])),
3416    Ub=smallest_UB(ordsets:from_list([Ub1,Ub2])),
3417    intersection_of_vr(S,[{'ValueRange',{Lb,Ub}}|Rest]);
3418intersection_of_vr(_S,VR) ->
3419    %%error({type,{asn1,{illegal_value_range_constraint,VR}},S});
3420    throw({error,{asn1,{illegal_value_range_constraint,VR}}}).
3421
3422intersection_of_sv(_,[]) ->
3423    [];
3424intersection_of_sv(_,SV=[_C]) ->
3425    SV;
3426intersection_of_sv(S,[SV,SV|Rest]) ->
3427    intersection_of_sv(S,[SV|Rest]);
3428intersection_of_sv(S,[{_,Int},{_,SV}|Rest]) when integer(Int),
3429						 list(SV) ->
3430    SV2=intersection_of_sv1(S,Int,SV),
3431    intersection_of_sv(S,[SV2|Rest]);
3432intersection_of_sv(S,[{_,SV},{_,Int}|Rest]) when integer(Int),
3433						 list(SV) ->
3434    SV2=intersection_of_sv1(S,Int,SV),
3435    intersection_of_sv(S,[SV2|Rest]);
3436intersection_of_sv(S,[{_,SV1},{_,SV2}|Rest]) when list(SV1),
3437						  list(SV2) ->
3438    SV3=common_set(SV1,SV2),
3439    intersection_of_sv(S,[SV3|Rest]);
3440intersection_of_sv(_S,SV) ->
3441    %%error({type,{asn1,{illegal_single_value_constraint,SV}},S}).
3442    throw({error,{asn1,{illegal_single_value_constraint,SV}}}).
3443
3444intersection_of_sv1(_S,Int,SV) when integer(Int),list(SV) ->
3445    case lists:member(Int,SV) of
3446	true -> {'SingleValue',Int};
3447	_ ->
3448	    %%error({type,{asn1,{illegal_single_value_constraint,Int,SV}},S})
3449	    throw({error,{asn1,{illegal_single_value_constraint,Int,SV}}})
3450    end;
3451intersection_of_sv1(_S,SV1,SV2) ->
3452    %%error({type,{asn1,{illegal_single_value_constraint,SV1,SV2}},S}).
3453    throw({error,{asn1,{illegal_single_value_constraint,SV1,SV2}}}).
3454
3455greatest_LB([H]) ->
3456    H;
3457greatest_LB(L) ->
3458    greatest_LB1(lists:reverse(L)).
3459greatest_LB1(['MIN',H2|_T])->
3460    H2;
3461greatest_LB1([H|_T]) ->
3462    H.
3463smallest_UB(L) ->
3464    hd(L).
3465
3466common_set(SV1,SV2) ->
3467    lists:filter(fun(X)->lists:member(X,SV1) end,SV2).
3468
3469is_int_in_vr(Int,{_,{'MIN','MAX'}}) when integer(Int) ->
3470    true;
3471is_int_in_vr(Int,{_,{'MIN',Ub}}) when integer(Int),Int =< Ub ->
3472    true;
3473is_int_in_vr(Int,{_,{Lb,'MAX'}}) when integer(Int),Int >= Lb ->
3474    true;
3475is_int_in_vr(Int,{_,{Lb,Ub}}) when integer(Int),Int >= Lb,Int =< Ub ->
3476    true;
3477is_int_in_vr(_,_) ->
3478    false.
3479
3480
3481
3482check_imported(_S,Imodule,Name) ->
3483    case asn1_db:dbget(Imodule,'MODULE') of
3484	undefined ->
3485	    io:format("~s.asn1db not found~n",[Imodule]),
3486	    io:format("Type ~s imported from non existing module ~s~n",[Name,Imodule]);
3487	Im when record(Im,module) ->
3488	    case is_exported(Im,Name) of
3489		false ->
3490		    io:format("Imported type ~s not exported from module ~s~n",[Name,Imodule]);
3491		_ ->
3492		    ok
3493	    end
3494    end,
3495    ok.
3496
3497is_exported(Module,Name) when record(Module,module) ->
3498    {exports,Exports} = Module#module.exports,
3499    case Exports of
3500	all ->
3501	    true;
3502	[] ->
3503	    false;
3504	L when list(L) ->
3505	    case lists:keysearch(Name,#'Externaltypereference'.type,Exports) of
3506		false -> false;
3507		_ -> true
3508	    end
3509    end.
3510
3511
3512
3513check_externaltypereference(S,Etref=#'Externaltypereference'{module=Emod})->
3514    Currmod = S#state.mname,
3515    MergedMods = S#state.inputmodules,
3516    case Emod of
3517	Currmod ->
3518	    %% reference to current module or to imported reference
3519		check_reference(S,Etref);
3520	 _ ->
3521	    %% io:format("Type ~s IMPORTED FROM ~s~n",[Etype,Emod]),
3522	    case lists:member(Emod,MergedMods) of
3523		true ->
3524		    check_reference(S,Etref);
3525		false ->
3526		    Etref
3527	    end
3528    end.
3529
3530check_reference(S,#'Externaltypereference'{pos=Pos,module=Emod,type=Name}) ->
3531    ModName = S#state.mname,
3532    case asn1_db:dbget(ModName,Name) of
3533	undefined ->
3534	    case imported(S,Name) of
3535		{ok,Imodule} ->
3536		    check_imported(S,Imodule,Name),
3537		    #'Externaltypereference'{module=Imodule,type=Name};
3538		_ ->
3539		    %may be a renamed type in multi file compiling!
3540		    {_,T}=renamed_reference(S,Name,Emod),
3541		    NewName = asn1ct:get_name_of_def(T),
3542		    NewPos = asn1ct:get_pos_of_def(T),
3543		    #'Externaltypereference'{pos=NewPos,
3544					     module=ModName,
3545					     type=NewName}
3546	    end;
3547	_ ->
3548	    %% cannot do check_type here due to recursive definitions, like
3549	    %% S ::= SEQUENCE {a INTEGER, b S}. This implies that references
3550	    %% that appear before the definition will be an
3551	    %% Externaltypereference in the abstract syntax tree
3552	    #'Externaltypereference'{pos=Pos,module=ModName,type=Name}
3553    end.
3554
3555
3556name2Extref(_Mod,Name) when record(Name,'Externaltypereference') ->
3557    Name;
3558name2Extref(Mod,Name) ->
3559    #'Externaltypereference'{module=Mod,type=Name}.
3560
3561get_referenced_type(S,Ext) when record(Ext,'Externaltypereference') ->
3562    case match_parameters(Ext, S#state.parameters) of
3563	Ext ->
3564	    #'Externaltypereference'{pos=Pos,module=Emod,type=Etype} = Ext,
3565	    case S#state.mname of
3566		Emod -> % a local reference in this module
3567		    get_referenced1(S,Emod,Etype,Pos);
3568		_ ->% always when multi file compiling
3569		    case lists:member(Emod,S#state.inputmodules) of
3570			true ->
3571			    get_referenced1(S,Emod,Etype,Pos);
3572			false ->
3573			    get_referenced(S,Emod,Etype,Pos)
3574		    end
3575	    end;
3576	Other ->
3577	    {undefined,Other}
3578    end;
3579get_referenced_type(S=#state{mname=Emod},
3580		    ERef=#'Externalvaluereference'{pos=P,module=Emod,
3581						   value=Eval}) ->
3582    case match_parameters(ERef,S#state.parameters) of
3583	ERef ->
3584	    get_referenced1(S,Emod,Eval,P);
3585	OtherERef when record(OtherERef,'Externalvaluereference') ->
3586	    get_referenced_type(S,OtherERef);
3587	Value ->
3588	    {Emod,Value}
3589    end;
3590get_referenced_type(S,ERef=#'Externalvaluereference'{pos=Pos,module=Emod,
3591						value=Eval}) ->
3592    case match_parameters(ERef,S#state.parameters) of
3593	ERef ->
3594	    case lists:member(Emod,S#state.inputmodules) of
3595		true ->
3596		    get_referenced1(S,Emod,Eval,Pos);
3597		false ->
3598		    get_referenced(S,Emod,Eval,Pos)
3599	    end;
3600	OtherERef  ->
3601	    get_referenced_type(S,OtherERef)
3602    end;
3603get_referenced_type(S,#identifier{val=Name,pos=Pos}) ->
3604    get_referenced1(S,undefined,Name,Pos);
3605get_referenced_type(_S,Type) ->
3606    {undefined,Type}.
3607
3608%% get_referenced/3
3609%% The referenced entity Ename may in case of an imported parameterized
3610%% type reference imported entities in the other module, which implies that
3611%% asn1_db:dbget will fail even though the referenced entity exists. Thus
3612%% Emod may be the module that imports the entity Ename and not holds the
3613%% data about Ename.
3614get_referenced(S,Emod,Ename,Pos) ->
3615    case asn1_db:dbget(Emod,Ename) of
3616	undefined ->
3617	    %% May be an imported entity in module Emod
3618%	    throw({error,{asn1,{undefined_type_or_value,{Emod,Ename}}}});
3619	    NewS = S#state{module=asn1_db:dbget(Emod,'MODULE')},
3620	    get_imported(NewS,Ename,Emod,Pos);
3621	T when record(T,typedef) ->
3622	    Spec = T#typedef.typespec,
3623	    case Spec#type.def of
3624		Tref when record(Tref,typereference) ->
3625		    Def = #'Externaltypereference'{module=Emod,
3626					     type=Tref#typereference.val,
3627					     pos=Tref#typereference.pos},
3628
3629
3630		    {Emod,T#typedef{typespec=Spec#type{def=Def}}};
3631		_ ->
3632		    {Emod,T} % should add check that T is exported here
3633	    end;
3634	V -> {Emod,V}
3635    end.
3636
3637get_referenced1(S,ModuleName,Name,Pos) ->
3638    case asn1_db:dbget(S#state.mname,Name) of
3639	undefined ->
3640	    %% ModuleName may be other than S#state.mname when
3641	    %% multi file compiling is used.
3642	    get_imported(S,Name,ModuleName,Pos);
3643	T ->
3644	    {S#state.mname,T}
3645    end.
3646
3647get_imported(S,Name,Module,Pos) ->
3648    case imported(S,Name) of
3649	{ok,Imodule} ->
3650	    case asn1_db:dbget(Imodule,'MODULE') of
3651		undefined ->
3652		    throw({error,{asn1,{module_not_found,Imodule}}});
3653		Im when record(Im,module) ->
3654		    case is_exported(Im,Name) of
3655			false ->
3656			    throw({error,
3657				   {asn1,{not_exported,{Im,Name}}}});
3658			_ ->
3659			    get_referenced_type(S,
3660						#'Externaltypereference'
3661						{module=Imodule,
3662						 type=Name,pos=Pos})
3663		    end
3664	    end;
3665	_ ->
3666	    renamed_reference(S,Name,Module)
3667    end.
3668
3669renamed_reference(S,Name,Module) ->
3670    %% first check if there is a renamed type in this module
3671    %% second check if any type was imported with this name
3672    case ets:info(renamed_defs) of
3673	undefined -> throw({error,{asn1,{undefined_type,Name}}});
3674	_ ->
3675	    case ets:match(renamed_defs,{'$1',Name,Module}) of
3676		[] ->
3677		    case ets:info(original_imports) of
3678			undefined ->
3679			    throw({error,{asn1,{undefined_type,Name}}});
3680			_  ->
3681			    case ets:match(original_imports,{Module,'$1'}) of
3682				[] ->
3683				    throw({error,{asn1,{undefined_type,Name}}});
3684				[[ImportsList]] ->
3685				    case get_importmoduleoftype(ImportsList,Name) of
3686					undefined ->
3687					    throw({error,{asn1,{undefined_type,Name}}});
3688					NextMod ->
3689					    renamed_reference(S,Name,NextMod)
3690				    end
3691			    end
3692		    end;
3693		[[NewTypeName]] ->
3694		    get_referenced1(S,Module,NewTypeName,undefined)
3695	    end
3696    end.
3697
3698get_importmoduleoftype([I|Is],Name) ->
3699    Index = #'Externaltypereference'.type,
3700    case lists:keysearch(Name,Index,I#'SymbolsFromModule'.symbols) of
3701	{value,_Ref} ->
3702	    (I#'SymbolsFromModule'.module)#'Externaltypereference'.type;
3703	_ ->
3704	    get_importmoduleoftype(Is,Name)
3705    end;
3706get_importmoduleoftype([],_) ->
3707    undefined.
3708
3709
3710match_parameters(Name,[]) ->
3711    Name;
3712
3713match_parameters(#'Externaltypereference'{type=Name},[{#'Externaltypereference'{type=Name},NewName}|_T]) ->
3714    NewName;
3715match_parameters(#'Externaltypereference'{type=Name},[{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) ->
3716    NewName;
3717% match_parameters(#'Externaltypereference'{type=Name},[{#typereference{val=Name},NewName}|T]) ->
3718%     NewName;
3719% match_parameters(#'Externaltypereference'{type=Name},[{{_,#typereference{val=Name}},NewName}|T]) ->
3720%     NewName;
3721%match_parameters(#typereference{val=Name},[{#typereference{val=Name},NewName}|T]) ->
3722%    NewName;
3723match_parameters(#'Externalvaluereference'{value=Name},[{#'Externalvaluereference'{value=Name},NewName}|_T]) ->
3724    NewName;
3725match_parameters(#'Externalvaluereference'{value=Name},[{{_,#'Externalvaluereference'{value=Name}},NewName}|_T]) ->
3726    NewName;
3727% match_parameters(#identifier{val=Name},[{#identifier{val=Name},NewName}|T]) ->
3728%     NewName;
3729% match_parameters(#identifier{val=Name},[{{_,#identifier{val=Name}},NewName}|T]) ->
3730%     NewName;
3731match_parameters({valueset,#type{def=#'Externaltypereference'{type=Name}}},
3732		 [{{_,#'Externaltypereference'{type=Name}},{valueset,#type{def=NewName}}}|_T]) ->
3733    NewName;
3734match_parameters({valueset,#type{def=#'Externaltypereference'{type=Name}}},
3735		 [{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) ->
3736    NewName;
3737% match_parameters({valueset,#type{def=#'Externaltypereference'{type=Name}}},
3738% 		 [{{_,#typereference{val=Name}},{valueset,#type{def=NewName}}}|T]) ->
3739%     NewName;
3740% match_parameters({valueset,#type{def=#'Externaltypereference'{type=Name}}},
3741% 		 [{{_,#typereference{val=Name}},NewName}|T]) ->
3742%     NewName;
3743
3744match_parameters(Name, [_H|T]) ->
3745    %%io:format("match_parameters(~p,~p)~n",[Name,[H|T]]),
3746    match_parameters(Name,T).
3747
3748imported(S,Name) ->
3749    {imports,Ilist} = (S#state.module)#module.imports,
3750    imported1(Name,Ilist).
3751
3752imported1(Name,
3753	  [#'SymbolsFromModule'{symbols=Symlist,
3754				module=#'Externaltypereference'{type=ModuleName}}|T]) ->
3755    case lists:keysearch(Name,#'Externaltypereference'.type,Symlist) of
3756	{value,_V} ->
3757	    {ok,ModuleName};
3758	_ ->
3759	    imported1(Name,T)
3760    end;
3761imported1(_Name,[]) ->
3762    false.
3763
3764
3765check_integer(_S,[],_C) ->
3766    ok;
3767check_integer(S,NamedNumberList,_C) ->
3768    case check_unique(NamedNumberList,2) of
3769	[] ->
3770	    check_int(S,NamedNumberList,[]);
3771	L when list(L) ->
3772	    error({type,{duplicates,L},S}),
3773	    unchanged
3774
3775    end.
3776
3777check_int(S,[{'NamedNumber',Id,Num}|T],Acc) when integer(Num) ->
3778    check_int(S,T,[{Id,Num}|Acc]);
3779check_int(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc) ->
3780    Val = dbget_ex(S,S#state.mname,Name),
3781    check_int(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc);
3782check_int(_S,[],Acc) ->
3783    lists:keysort(2,Acc).
3784
3785
3786
3787check_bitstring(_S,[],_Constr) ->
3788    [];
3789check_bitstring(S,NamedNumberList,_Constr) ->
3790    case check_unique(NamedNumberList,2) of
3791	[] ->
3792	    check_bitstr(S,NamedNumberList,[]);
3793	L when list(L) ->
3794	    error({type,{duplicates,L},S}),
3795	    unchanged
3796    end.
3797
3798check_bitstr(S,[{'NamedNumber',Id,Num}|T],Acc)when integer(Num) ->
3799    check_bitstr(S,T,[{Id,Num}|Acc]);
3800check_bitstr(S,[{'NamedNumber',Id,Name}|T],Acc) when atom(Name) ->
3801%%check_bitstr(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc) ->
3802%%    io:format("asn1ct_check:check_bitstr/3 hej hop ~w~n",[Name]),
3803    Val = dbget_ex(S,S#state.mname,Name),
3804%%    io:format("asn1ct_check:check_bitstr/3: ~w~n",[Val]),
3805    check_bitstr(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc);
3806check_bitstr(S,[],Acc) ->
3807    case check_unique(Acc,2) of
3808	[] ->
3809	    lists:keysort(2,Acc);
3810	L when list(L) ->
3811	    error({type,{duplicate_values,L},S}),
3812	    unchanged
3813    end.
3814
3815%%check_bitstring(S,NamedNumberList,Constr) ->
3816%%    NamedNumberList.
3817
3818%% Check INSTANCE OF
3819%% check that DefinedObjectClass is of TYPE-IDENTIFIER class
3820%% If Constraint is empty make it the general INSTANCE OF type
3821%% If Constraint is not empty make an inlined type
3822%% convert INSTANCE OF to the associated type
3823check_instance_of(S,DefinedObjectClass,Constraint) ->
3824    check_type_identifier(S,DefinedObjectClass),
3825    iof_associated_type(S,Constraint).
3826
3827
3828check_type_identifier(_S,'TYPE-IDENTIFIER') ->
3829    ok;
3830check_type_identifier(S,Eref=#'Externaltypereference'{}) ->
3831    case get_referenced_type(S,Eref) of
3832	{_,#classdef{name='TYPE-IDENTIFIER'}} -> ok;
3833	{_,TD=#typedef{typespec=#type{def=#'Externaltypereference'{}}}} ->
3834	    check_type_identifier(S,(TD#typedef.typespec)#type.def);
3835	_ ->
3836	    error({type,{"object set in type INSTANCE OF "
3837			 "not of class TYPE-IDENTIFIER",Eref},S})
3838    end.
3839
3840iof_associated_type(S,[]) ->
3841    %% in this case encode/decode functions for INSTANCE OF must be
3842    %% generated
3843    case get(instance_of) of
3844	undefined ->
3845	    AssociateSeq = iof_associated_type1(S,[]),
3846	    Tag =
3847		case S#state.erule of
3848		    ber_bin_v2 ->
3849			[?TAG_CONSTRUCTED(?N_INSTANCE_OF)];
3850		    _ -> []
3851		end,
3852	    TypeDef=#typedef{checked=true,
3853			     name='INSTANCE OF',
3854			     typespec=#type{tag=Tag,
3855					    def=AssociateSeq}},
3856	    asn1_db:dbput(S#state.mname,'INSTANCE OF',TypeDef),
3857	    put(instance_of,generate);
3858	_ ->
3859	    ok
3860    end,
3861    #'Externaltypereference'{module=S#state.mname,type='INSTANCE OF'};
3862iof_associated_type(S,C) ->
3863    iof_associated_type1(S,C).
3864
3865iof_associated_type1(S,C) ->
3866    {TableCInf,Comp1Cnstr,Comp2Cnstr,Comp2tablecinf}=
3867	instance_of_constraints(S,C),
3868
3869    ModuleName = S#state.mname,
3870    Typefield_type=
3871	case C of
3872	    [] -> 'ASN1_OPEN_TYPE';
3873	    _ -> {typefield,'Type'}
3874	end,
3875    {ObjIdTag,C1TypeTag}=
3876	case S#state.erule of
3877	    ber_bin_v2 ->
3878		{[{'UNIVERSAL',8}],
3879		 [#tag{class='UNIVERSAL',
3880		       number=6,
3881		       type='IMPLICIT',
3882		       form=0}]};
3883	    _ -> {[{'UNIVERSAL','INTEGER'}],[]}
3884	end,
3885    TypeIdentifierRef=#'Externaltypereference'{module=ModuleName,
3886					       type='TYPE-IDENTIFIER'},
3887    ObjectIdentifier =
3888	#'ObjectClassFieldType'{classname=TypeIdentifierRef,
3889				class=[],
3890				fieldname={id,[]},
3891				type={fixedtypevaluefield,id,
3892				      #type{def='OBJECT IDENTIFIER'}}},
3893    Typefield =
3894	#'ObjectClassFieldType'{classname=TypeIdentifierRef,
3895				class=[],
3896				fieldname={'Type',[]},
3897				type=Typefield_type},
3898    IOFComponents =
3899	[#'ComponentType'{name='type-id',
3900			  typespec=#type{tag=C1TypeTag,
3901					 def=ObjectIdentifier,
3902					 constraint=Comp1Cnstr},
3903			  prop=mandatory,
3904			  tags=ObjIdTag},
3905	 #'ComponentType'{name=value,
3906			  typespec=#type{tag=[#tag{class='CONTEXT',
3907						   number=0,
3908						   type='EXPLICIT',
3909						   form=32}],
3910					 def=Typefield,
3911					 constraint=Comp2Cnstr,
3912					 tablecinf=Comp2tablecinf},
3913			  prop=mandatory,
3914			  tags=[{'CONTEXT',0}]}],
3915    #'SEQUENCE'{tablecinf=TableCInf,
3916		components=IOFComponents}.
3917
3918
3919%% returns the leading attribute, the constraint of the components and
3920%% the tablecinf value for the second component.
3921instance_of_constraints(_,[]) ->
3922    {false,[],[],[]};
3923instance_of_constraints(S,#constraint{c={simpletable,Type}}) ->
3924    #type{def=#'Externaltypereference'{type=Name}} = Type,
3925    ModuleName = S#state.mname,
3926    ObjectSetRef=#'Externaltypereference'{module=ModuleName,
3927					  type=Name},
3928    CRel=[{componentrelation,{objectset,
3929			      undefined, %% pos
3930			      ObjectSetRef},
3931			      [{innermost,
3932				[#'Externalvaluereference'{module=ModuleName,
3933							   value=type}]}]}],
3934    TableCInf=#simpletableattributes{objectsetname=Name,
3935				     c_name='type-id',
3936				     c_index=1,
3937				     usedclassfield=id,
3938				     uniqueclassfield=id,
3939				     valueindex=[]},
3940    {TableCInf,[{simpletable,Name}],CRel,[{objfun,ObjectSetRef}]}.
3941
3942%% Check ENUMERATED
3943%% ****************************************
3944%% Check that all values are unique
3945%% assign values to un-numbered identifiers
3946%% check that the constraints are allowed and correct
3947%% put the updated info back into database
3948check_enumerated(_S,[{Name,Number}|Rest],_Constr) when atom(Name), integer(Number)->
3949    %% already checked , just return the same list
3950    [{Name,Number}|Rest];
3951check_enumerated(S,NamedNumberList,_Constr) ->
3952    check_enum(S,NamedNumberList,[],[]).
3953
3954%% identifiers are put in Acc2
3955%% returns either [{Name,Number}] or {[{Name,Number}],[{ExtName,ExtNumber}]}
3956%% the latter is returned if the ENUMERATION contains EXTENSIONMARK
3957check_enum(S,[{'NamedNumber',Id,Num}|T],Acc1,Acc2) when integer(Num) ->
3958    check_enum(S,T,[{Id,Num}|Acc1],Acc2);
3959check_enum(S,[{'NamedNumber',Id,{identifier,_,Name}}|T],Acc1,Acc2) ->
3960    Val = dbget_ex(S,S#state.mname,Name),
3961    check_enum(S,[{'NamedNumber',Id,Val#valuedef.value}|T],Acc1,Acc2);
3962check_enum(S,['EXTENSIONMARK'|T],Acc1,Acc2) ->
3963    NewAcc2 = lists:keysort(2,Acc1),
3964    NewList = enum_number(lists:reverse(Acc2),NewAcc2,0,[]),
3965    { NewList, check_enum(S,T,[],[])};
3966check_enum(S,[Id|T],Acc1,Acc2) when atom(Id) ->
3967    check_enum(S,T,Acc1,[Id|Acc2]);
3968check_enum(_S,[],Acc1,Acc2) ->
3969    NewAcc2 = lists:keysort(2,Acc1),
3970    enum_number(lists:reverse(Acc2),NewAcc2,0,[]).
3971
3972
3973% assign numbers to identifiers , numbers from 0 ... but must not
3974% be the same as already assigned to NamedNumbers
3975enum_number([H|T],[{Id,Num}|T2],Cnt,Acc) when Num > Cnt ->
3976    enum_number(T,[{Id,Num}|T2],Cnt+1,[{H,Cnt}|Acc]);
3977enum_number([H|T],[{Id,Num}|T2],Cnt,Acc) when Num < Cnt -> % negative Num
3978    enum_number(T,T2,Cnt+1,[{H,Cnt},{Id,Num}|Acc]);
3979enum_number([],L2,_Cnt,Acc) ->
3980    lists:concat([lists:reverse(Acc),L2]);
3981enum_number(L,[{Id,Num}|T2],Cnt,Acc) -> % Num == Cnt
3982    enum_number(L,T2,Cnt+1,[{Id,Num}|Acc]);
3983enum_number([H|T],[],Cnt,Acc) ->
3984    enum_number(T,[],Cnt+1,[{H,Cnt}|Acc]).
3985
3986
3987check_boolean(_S,_Constr) ->
3988    ok.
3989
3990check_octetstring(_S,_Constr) ->
3991    ok.
3992
3993% check all aspects of a SEQUENCE
3994% - that all component names are unique
3995% - that all TAGS are ok (when TAG default is applied)
3996% - that each component is of a valid type
3997% - that the extension marks are valid
3998
3999check_sequence(S,Type,Comps)  ->
4000    Components = expand_components(S,Comps),
4001    case check_unique([C||C <- Components ,record(C,'ComponentType')]
4002		      ,#'ComponentType'.name) of
4003	[] ->
4004	    %% sort_canonical(Components),
4005	    Components2 = maybe_automatic_tags(S,Components),
4006	    %% check the table constraints from here. The outermost type
4007	    %% is Type, the innermost is Comps (the list of components)
4008	    NewComps =
4009		case check_each_component(S,Type,Components2) of
4010		    NewComponents when list(NewComponents) ->
4011			check_unique_sequence_tags(S,NewComponents),
4012			NewComponents;
4013		    Ret = {NewComponents,NewEcomps} ->
4014			TagComps = NewComponents ++
4015			    [Comp#'ComponentType'{prop='OPTIONAL'}|| Comp <- NewEcomps],
4016			%% extension components are like optionals when it comes to tagging
4017			check_unique_sequence_tags(S,TagComps),
4018			Ret
4019		end,
4020	    %% CRelInf is the "leading attribute" information
4021	    %% necessary for code generating of the look up in the
4022	    %% object set table,
4023	    %% i.e. getenc_ObjectSet/getdec_ObjectSet.
4024	    %% {objfun,ERef} tuple added in NewComps2 in tablecinf
4025	    %% field in type record of component relation constrained
4026	    %% type
4027%	    io:format("NewComps: ~p~n",[NewComps]),
4028	    {CRelInf,NewComps2} = componentrelation_leadingattr(S,NewComps),
4029%	    io:format("CRelInf: ~p~n",[CRelInf]),
4030%	    io:format("NewComps2: ~p~n",[NewComps2]),
4031	    %% CompListWithTblInf has got a lot unnecessary info about
4032	    %% the involved class removed, as the class of the object
4033	    %% set.
4034	    CompListWithTblInf = get_tableconstraint_info(S,Type,NewComps2),
4035%	    io:format("CompListWithTblInf: ~p~n",[CompListWithTblInf]),
4036	    {CRelInf,CompListWithTblInf};
4037	Dupl ->
4038		throw({error,{asn1,{duplicate_components,Dupl}}})
4039    end.
4040
4041expand_components(S, [{'COMPONENTS OF',Type}|T]) ->
4042    CompList =
4043	case get_referenced_type(S,Type#type.def) of
4044	    {_,#typedef{typespec=#type{def=Seq}}} when record(Seq,'SEQUENCE') ->
4045		case Seq#'SEQUENCE'.components of
4046		    {Root,_Ext} -> Root;
4047		    Root -> Root
4048		end;
4049	    Err -> throw({error,{asn1,{illegal_COMPONENTS_OF,Err}}})
4050	end,
4051    expand_components(S,CompList) ++ expand_components(S,T);
4052expand_components(S,[H|T]) ->
4053    [H|expand_components(S,T)];
4054expand_components(_,[]) ->
4055    [].
4056
4057check_unique_sequence_tags(S,[#'ComponentType'{prop=mandatory}|Rest]) ->
4058    check_unique_sequence_tags(S,Rest);
4059check_unique_sequence_tags(S,[C|Rest]) when record(C,'ComponentType') ->
4060    check_unique_sequence_tags1(S,Rest,[C]);% optional or default
4061check_unique_sequence_tags(S,[_ExtensionMarker|Rest]) ->
4062    check_unique_sequence_tags(S,Rest);
4063check_unique_sequence_tags(_S,[]) ->
4064    true.
4065
4066check_unique_sequence_tags1(S,[C|Rest],Acc) when record(C,'ComponentType') ->
4067    case C#'ComponentType'.prop of
4068	mandatory ->
4069	    check_unique_tags(S,lists:reverse([C|Acc])),
4070	    check_unique_sequence_tags(S,Rest);
4071	_  ->
4072	    check_unique_sequence_tags1(S,Rest,[C|Acc]) % default or optional
4073    end;
4074check_unique_sequence_tags1(S,[H|Rest],Acc) ->
4075    check_unique_sequence_tags1(S,Rest,[H|Acc]);
4076check_unique_sequence_tags1(S,[],Acc) ->
4077    check_unique_tags(S,lists:reverse(Acc)).
4078
4079check_sequenceof(S,Type,Component) when record(Component,type) ->
4080    check_type(S,Type,Component).
4081
4082check_set(S,Type,Components) ->
4083    {TableCInf,NewComponents} = check_sequence(S,Type,Components),
4084    case lists:member(der,S#state.options) of
4085	true when S#state.erule == ber;
4086		  S#state.erule == ber_bin ->
4087	    {Sorted,SortedComponents} =
4088		sort_components(S#state.tname,
4089				(S#state.module)#module.tagdefault,
4090				NewComponents),
4091	    {Sorted,TableCInf,SortedComponents};
4092	_ ->
4093	    {false,TableCInf,NewComponents}
4094    end.
4095
4096sort_components(_TypeName,'AUTOMATIC',Components) ->
4097    {true,Components};
4098sort_components(TypeName,_TagDefault,Components) ->
4099    case untagged_choice(Components) of
4100	false ->
4101	    {true,sort_components1(TypeName,Components,[],[],[],[])};
4102	true ->
4103	    {dynamic,Components} % sort in run-time
4104    end.
4105
4106sort_components1(TypeName,[C=#'ComponentType'{tags=[{'UNIVERSAL',_}|_R]}|Cs],
4107		 UnivAcc,ApplAcc,ContAcc,PrivAcc) ->
4108    sort_components1(TypeName,Cs,[C|UnivAcc],ApplAcc,ContAcc,PrivAcc);
4109sort_components1(TypeName,[C=#'ComponentType'{tags=[{'APPLICATION',_}|_R]}|Cs],
4110		 UnivAcc,ApplAcc,ContAcc,PrivAcc) ->
4111    sort_components1(TypeName,Cs,UnivAcc,[C|ApplAcc],ContAcc,PrivAcc);
4112sort_components1(TypeName,[C=#'ComponentType'{tags=[{'CONTEXT',_}|_R]}|Cs],
4113		 UnivAcc,ApplAcc,ContAcc,PrivAcc) ->
4114    sort_components1(TypeName,Cs,UnivAcc,ApplAcc,[C|ContAcc],PrivAcc);
4115sort_components1(TypeName,[C=#'ComponentType'{tags=[{'PRIVATE',_}|_R]}|Cs],
4116		 UnivAcc,ApplAcc,ContAcc,PrivAcc) ->
4117    sort_components1(TypeName,Cs,UnivAcc,ApplAcc,ContAcc,[C|PrivAcc]);
4118sort_components1(TypeName,[],UnivAcc,ApplAcc,ContAcc,PrivAcc) ->
4119    I = #'ComponentType'.tags,
4120    ascending_order_check(TypeName,sort_universal_type(UnivAcc)) ++
4121	ascending_order_check(TypeName,lists:keysort(I,ApplAcc)) ++
4122	ascending_order_check(TypeName,lists:keysort(I,ContAcc)) ++
4123	ascending_order_check(TypeName,lists:keysort(I,PrivAcc)).
4124
4125ascending_order_check(TypeName,Components) ->
4126    ascending_order_check1(TypeName,Components),
4127    Components.
4128
4129ascending_order_check1(TypeName,
4130		       [C1 = #'ComponentType'{tags=[{_,T}|_]},
4131			C2 = #'ComponentType'{tags=[{_,T}|_]}|Rest]) ->
4132    io:format("WARNING: Indistinct tag ~p in SET ~p, components ~p and ~p~n",
4133	      [T,TypeName,C1#'ComponentType'.name,C2#'ComponentType'.name]),
4134    ascending_order_check1(TypeName,[C2|Rest]);
4135ascending_order_check1(TypeName,
4136		       [C1 = #'ComponentType'{tags=[{'UNIVERSAL',T1}|_]},
4137			C2 = #'ComponentType'{tags=[{'UNIVERSAL',T2}|_]}|Rest]) ->
4138    case (asn1ct_gen_ber:decode_type(T1) == asn1ct_gen_ber:decode_type(T2)) of
4139	true ->
4140	    io:format("WARNING: Indistinct tags ~p and ~p in"
4141		      " SET ~p, components ~p and ~p~n",
4142		      [T1,T2,TypeName,C1#'ComponentType'.name,
4143		       C2#'ComponentType'.name]),
4144	    ascending_order_check1(TypeName,[C2|Rest]);
4145	_ ->
4146	    ascending_order_check1(TypeName,[C2|Rest])
4147    end;
4148ascending_order_check1(N,[_|Rest]) ->
4149    ascending_order_check1(N,Rest);
4150ascending_order_check1(_,[_]) ->
4151    ok;
4152ascending_order_check1(_,[]) ->
4153    ok.
4154
4155sort_universal_type(Components) ->
4156    List = lists:map(fun(C) ->
4157			     #'ComponentType'{tags=[{_,T}|_]} = C,
4158			     {asn1ct_gen_ber:decode_type(T),C}
4159		     end,
4160		     Components),
4161    SortedList = lists:keysort(1,List),
4162    lists:map(fun(X)->element(2,X) end,SortedList).
4163
4164untagged_choice([#'ComponentType'{typespec=#type{tag=[],def={'CHOICE',_}}}|_Rest]) ->
4165    true;
4166untagged_choice([_|Rest]) ->
4167    untagged_choice(Rest);
4168untagged_choice([]) ->
4169    false.
4170
4171check_setof(S,Type,Component) when record(Component,type) ->
4172    check_type(S,Type,Component).
4173
4174check_restrictedstring(_S,_Def,_Constr) ->
4175    ok.
4176
4177check_objectidentifier(_S,_Constr) ->
4178    ok.
4179
4180% check all aspects of a CHOICE
4181% - that all alternative names are unique
4182% - that all TAGS are ok (when TAG default is applied)
4183% - that each alternative is of a valid type
4184% - that the extension marks are valid
4185check_choice(S,Type,Components) when list(Components) ->
4186    case check_unique([C||C <- Components,
4187			  record(C,'ComponentType')],#'ComponentType'.name) of
4188	[] ->
4189    %%    sort_canonical(Components),
4190	    Components2 = maybe_automatic_tags(S,Components),
4191	    %NewComps =
4192	    case check_each_alternative(S,Type,Components2) of
4193		{NewComponents,NewEcomps} ->
4194		    check_unique_tags(S,NewComponents ++ NewEcomps),
4195		    {NewComponents,NewEcomps};
4196		NewComponents ->
4197		    check_unique_tags(S,NewComponents),
4198		    NewComponents
4199	    end;
4200%%	    CompListWithTblInf = get_tableconstraint_info(S,Type,NewComps);
4201	Dupl ->
4202	    throw({error,{asn1,{duplicate_choice_alternatives,Dupl}}})
4203    end;
4204check_choice(_S,_,[]) ->
4205    [].
4206
4207%% probably dead code that should be removed
4208%%maybe_automatic_tags(S,{Rc,Ec}) ->
4209%%    {maybe_automatic_tags1(S,Rc,0),maybe_automatic_tags1(S,Ec,length(Rc))};
4210maybe_automatic_tags(#state{erule=per},C) ->
4211    C;
4212maybe_automatic_tags(#state{erule=per_bin},C) ->
4213    C;
4214maybe_automatic_tags(S,C) ->
4215    maybe_automatic_tags1(S,C,0).
4216
4217maybe_automatic_tags1(S,C,TagNo) ->
4218    case (S#state.module)#module.tagdefault of
4219	'AUTOMATIC' ->
4220	    generate_automatic_tags(S,C,TagNo);
4221	_ ->
4222	    %% maybe is the module a multi file module were only some of
4223	    %% the modules have defaulttag AUTOMATIC TAGS then the names
4224	    %% of those types are saved in the table automatic_tags
4225	    Name= S#state.tname,
4226	    case is_automatic_tagged_in_multi_file(Name) of
4227		true ->
4228		    generate_automatic_tags(S,C,TagNo);
4229		false ->
4230		    C
4231	    end
4232    end.
4233
4234is_automatic_tagged_in_multi_file(Name) ->
4235    case ets:info(automatic_tags) of
4236	undefined ->
4237	    %% this case when not multifile compilation
4238	    false;
4239	_ ->
4240	    case ets:member(automatic_tags,Name) of
4241		true ->
4242		     true;
4243		_ ->
4244		    false
4245	    end
4246    end.
4247
4248generate_automatic_tags(_S,C,TagNo) ->
4249    case any_manual_tag(C) of
4250	true ->
4251	    C;
4252	false ->
4253	    generate_automatic_tags1(C,TagNo)
4254    end.
4255
4256generate_automatic_tags1([H|T],TagNo) when record(H,'ComponentType') ->
4257    #'ComponentType'{typespec=Ts} = H,
4258    NewTs = Ts#type{tag=[#tag{class='CONTEXT',
4259			     number=TagNo,
4260			     type={default,'IMPLICIT'},
4261			     form= 0 }]}, % PRIMITIVE
4262    [H#'ComponentType'{typespec=NewTs}|generate_automatic_tags1(T,TagNo+1)];
4263generate_automatic_tags1([ExtMark|T],TagNo) -> % EXTENSIONMARK
4264    [ExtMark | generate_automatic_tags1(T,TagNo)];
4265generate_automatic_tags1([],_) ->
4266    [].
4267
4268any_manual_tag([#'ComponentType'{typespec=#type{tag=[]}}|Rest]) ->
4269    any_manual_tag(Rest);
4270any_manual_tag([{'EXTENSIONMARK',_,_}|Rest]) ->
4271    any_manual_tag(Rest);
4272any_manual_tag([_|_Rest]) ->
4273    true;
4274any_manual_tag([]) ->
4275    false.
4276
4277
4278check_unique_tags(S,C) ->
4279    case (S#state.module)#module.tagdefault of
4280	'AUTOMATIC' ->
4281	    case any_manual_tag(C) of
4282		false -> true;
4283		_ -> collect_and_sort_tags(C,[])
4284	    end;
4285	_ ->
4286	    collect_and_sort_tags(C,[])
4287    end.
4288
4289collect_and_sort_tags([C|Rest],Acc) when record(C,'ComponentType') ->
4290    collect_and_sort_tags(Rest,C#'ComponentType'.tags ++ Acc);
4291collect_and_sort_tags([_|Rest],Acc) ->
4292    collect_and_sort_tags(Rest,Acc);
4293collect_and_sort_tags([],Acc) ->
4294    {Dupl,_}= lists:mapfoldl(fun(El,El)->{{dup,El},El};(El,_Prev)-> {El,El} end,notag,lists:sort(Acc)),
4295    Dupl2 = [Dup|| {dup,Dup} <- Dupl],
4296    if
4297	length(Dupl2) > 0 ->
4298	    throw({error,{asn1,{duplicates_of_the_tags,Dupl2}}});
4299	true ->
4300	    true
4301    end.
4302
4303check_unique(L,Pos) ->
4304    Slist = lists:keysort(Pos,L),
4305    check_unique2(Slist,Pos,[]).
4306
4307check_unique2([A,B|T],Pos,Acc) when element(Pos,A) == element(Pos,B) ->
4308    check_unique2([B|T],Pos,[element(Pos,B)|Acc]);
4309check_unique2([_|T],Pos,Acc) ->
4310    check_unique2(T,Pos,Acc);
4311check_unique2([],_,Acc) ->
4312    lists:reverse(Acc).
4313
4314check_each_component(S,Type,{Rlist,ExtList}) ->
4315    {check_each_component(S,Type,Rlist),
4316     check_each_component(S,Type,ExtList)};
4317check_each_component(S,Type,Components) ->
4318    check_each_component(S,Type,Components,[],[],noext).
4319
4320check_each_component(S = #state{abscomppath=Path,recordtopname=TopName},Type,
4321		     [C|Ct],Acc,Extacc,Ext) when record(C,'ComponentType') ->
4322    #'ComponentType'{name=Cname,typespec=Ts,prop=Prop} = C,
4323    NewAbsCPath =
4324	case Ts#type.def of
4325	    #'Externaltypereference'{} -> [];
4326	    _ -> [Cname|Path]
4327	end,
4328    CheckedTs = check_type(S#state{abscomppath=NewAbsCPath,
4329				   recordtopname=[Cname|TopName]},Type,Ts),
4330    NewTags = get_taglist(S,CheckedTs),
4331
4332    NewProp =
4333%	case lists:member(der,S#state.options) of
4334%	    true ->
4335%	    True ->
4336	case normalize_value(S,CheckedTs,Prop,[Cname|TopName]) of
4337	    mandatory -> mandatory;
4338	    'OPTIONAL' -> 'OPTIONAL';
4339	    DefaultValue -> {'DEFAULT',DefaultValue}
4340	end,
4341%	    _ ->
4342%		Prop
4343%	end,
4344    NewC = C#'ComponentType'{typespec=CheckedTs,prop=NewProp,tags=NewTags},
4345    case Ext of
4346	noext ->
4347	    check_each_component(S,Type,Ct,[NewC|Acc],Extacc,Ext);
4348	ext ->
4349	    check_each_component(S,Type,Ct,Acc,[NewC|Extacc],Ext)
4350    end;
4351check_each_component(S,Type,[_|Ct],Acc,Extacc,noext) -> % skip 'EXTENSIONMARK'
4352    check_each_component(S,Type,Ct,Acc,Extacc,ext);
4353check_each_component(_S,_,[_C|_Ct],_,_,ext) -> % skip 'EXTENSIONMARK'
4354    throw({error,{asn1,{too_many_extension_marks}}});
4355check_each_component(_S,_,[],Acc,Extacc,ext) ->
4356    {lists:reverse(Acc),lists:reverse(Extacc)};
4357check_each_component(_S,_,[],Acc,_,noext) ->
4358    lists:reverse(Acc).
4359
4360check_each_alternative(S,Type,{Rlist,ExtList}) ->
4361    {check_each_alternative(S,Type,Rlist),
4362     check_each_alternative(S,Type,ExtList)};
4363check_each_alternative(S,Type,[C|Ct]) ->
4364    check_each_alternative(S,Type,[C|Ct],[],[],noext).
4365
4366check_each_alternative(S=#state{abscomppath=Path,recordtopname=TopName},Type,[C|Ct],
4367		       Acc,Extacc,Ext) when record(C,'ComponentType') ->
4368    #'ComponentType'{name=Cname,typespec=Ts,prop=_Prop} = C,
4369    NewAbsCPath =
4370	case Ts#type.def of
4371	    #'Externaltypereference'{} -> [];
4372	    _ -> [Cname|Path]
4373	end,
4374    NewState =
4375	S#state{abscomppath=NewAbsCPath,recordtopname=[Cname|TopName]},
4376    CheckedTs = check_type(NewState,Type,Ts),
4377    NewTags = get_taglist(S,CheckedTs),
4378    NewC = C#'ComponentType'{typespec=CheckedTs,tags=NewTags},
4379    case Ext of
4380	noext ->
4381	    check_each_alternative(S,Type,Ct,[NewC|Acc],Extacc,Ext);
4382	ext ->
4383	    check_each_alternative(S,Type,Ct,Acc,[NewC|Extacc],Ext)
4384    end;
4385
4386check_each_alternative(S,Type,[_|Ct],Acc,Extacc,noext) -> % skip 'EXTENSIONMARK'
4387    check_each_alternative(S,Type,Ct,Acc,Extacc,ext);
4388check_each_alternative(_S,_,[_C|_Ct],_,_,ext) -> % skip 'EXTENSIONMARK'
4389    throw({error,{asn1,{too_many_extension_marks}}});
4390check_each_alternative(_S,_,[],Acc,Extacc,ext) ->
4391    {lists:reverse(Acc),lists:reverse(Extacc)};
4392check_each_alternative(_S,_,[],Acc,_,noext) ->
4393    lists:reverse(Acc).
4394
4395%% componentrelation_leadingattr/2 searches the structure for table
4396%% constraints, if any is found componentrelation_leadingattr/5 is
4397%% called.
4398componentrelation_leadingattr(S,CompList) ->
4399%    {Cs1,Cs2} =
4400    Cs =
4401	case CompList of
4402	    {Components,EComponents} when list(Components) ->
4403%		{Components,Components};
4404		Components ++ EComponents;
4405	    CompList when list(CompList) ->
4406%		{CompList,CompList}
4407		CompList
4408	end,
4409%    case any_simple_table(S,Cs1,[]) of
4410
4411    %% get_simple_table_if_used/2 should find out whether there are any
4412    %% component relation constraints in the entire tree of Cs1 that
4413    %% relates to this level. It returns information about the simple
4414    %% table constraint necessary for the the call to
4415    %% componentrelation_leadingattr/6. The step when the leading
4416    %% attribute and the syntax tree is modified to support the code
4417    %% generating.
4418    case get_simple_table_if_used(S,Cs) of
4419	[] -> {false,CompList};
4420	STList ->
4421%	    componentrelation_leadingattr(S,Cs1,Cs2,STList,[],[])
4422	    componentrelation_leadingattr(S,Cs,Cs,STList,[],[])
4423    end.
4424
4425%% componentrelation_leadingattr/6 when all components are searched
4426%% the new modified components are returned together with the "leading
4427%% attribute" information, which later is stored in the tablecinf
4428%% field in the SEQUENCE/SET record. The "leading attribute"
4429%% information is used to generate the lookup in the object set
4430%% table. The other information gathered in the #type.tablecinf field
4431%% is used in code generating phase too, to recognice the proper
4432%% components for "open type" encoding and to propagate the result of
4433%% the object set lookup when needed.
4434componentrelation_leadingattr(_,[],_CompList,_,[],NewCompList) ->
4435    {false,lists:reverse(NewCompList)};
4436componentrelation_leadingattr(_,[],_CompList,_,LeadingAttr,NewCompList) ->
4437    {lists:last(LeadingAttr),lists:reverse(NewCompList)}; %send all info in Ts later
4438componentrelation_leadingattr(S,[C|Cs],CompList,STList,Acc,CompAcc) ->
4439    {LAAcc,NewC} =
4440	case catch componentrelation1(S,C#'ComponentType'.typespec,
4441				      [C#'ComponentType'.name]) of
4442	    {'EXIT',_} ->
4443		{[],C};
4444	    {CRI=[{_A1,_B1,_C1,_D1}|_Rest],NewTSpec} ->
4445		%% {ObjectSet,AtPath,ClassDef,Path}
4446		%% _A1 is a reference to the object set of the
4447		%% component relation constraint.
4448		%% _B1 is the path of names in the at-list of the
4449		%% component relation constraint.
4450		%% _C1 is the class definition of the
4451		%% ObjectClassFieldType.
4452		%% _D1 is the path of components that was traversed to
4453		%% find this constraint.
4454		case leading_attr_index(S,CompList,CRI,
4455					lists:reverse(S#state.abscomppath),[]) of
4456		    [] ->
4457			{[],C};
4458		    [{ObjSet,Attr,N,ClassDef,_Path,ValueIndex}|_NewRest] ->
4459			OS = object_set_mod_name(S,ObjSet),
4460			UniqueFieldName =
4461			    case (catch get_unique_fieldname(#classdef{typespec=ClassDef})) of
4462				{error,'__undefined_'} ->
4463				    no_unique;
4464				{asn1,Msg,_} ->
4465				    error({type,Msg,S});
4466				Other -> Other
4467			    end,
4468%			UsedFieldName = get_used_fieldname(S,Attr,STList),
4469			%% Res should be done differently: even though
4470			%% a unique field name exists it is not
4471			%% certain that the ObjectClassFieldType of
4472			%% the simple table constraint picks that
4473			%% class field.
4474			Res = #simpletableattributes{objectsetname=OS,
4475%%						     c_name=asn1ct_gen:un_hyphen_var(Attr),
4476						     c_name=Attr,
4477						     c_index=N,
4478						     usedclassfield=UniqueFieldName,
4479						     uniqueclassfield=UniqueFieldName,
4480						     valueindex=ValueIndex},
4481			{[Res],C#'ComponentType'{typespec=NewTSpec}}
4482		end;
4483	    _ ->
4484		%% no constraint was found
4485		{[],C}
4486	end,
4487    componentrelation_leadingattr(S,Cs,CompList,STList,LAAcc++Acc,
4488				  [NewC|CompAcc]).
4489
4490object_set_mod_name(_S,ObjSet) when atom(ObjSet) ->
4491    ObjSet;
4492object_set_mod_name(#state{mname=M},
4493		    #'Externaltypereference'{module=M,type=T}) ->
4494    T;
4495object_set_mod_name(S,#'Externaltypereference'{module=M,type=T}) ->
4496    case lists:member(M,S#state.inputmodules) of
4497	true ->
4498	    T;
4499	false ->
4500	    {M,T}
4501    end.
4502
4503%% get_used_fieldname gets the used field of the class referenced by
4504%% the ObjectClassFieldType construct in the simple table constraint
4505%% corresponding to the component relation constraint that depends on
4506%% it.
4507% get_used_fieldname(_S,CName,[{[CName|_Rest],_,ClFieldName}|_RestSimpleT]) ->
4508%     ClFieldName;
4509% get_used_fieldname(S,CName,[_SimpleTC|Rest]) ->
4510%     get_used_fieldname(S,CName,Rest);
4511% get_used_fieldname(S,_,[]) ->
4512%     error({type,"Error in Simple table constraint",S}).
4513
4514%% any_simple_table/3 checks if any of the components on this level is
4515%% constrained by a simple table constraint. It returns a list of
4516%% tuples with three elements. It is a name path to the place in the
4517%% type structure where the constraint is, and the name of the object
4518%% set and the referenced field in the class.
4519% any_simple_table(S = #state{mname=M,abscomppath=Path},
4520% 		 [#'ComponentType'{name=Name,typespec=Type}|Cs],Acc) ->
4521%     Constraint = Type#type.constraint,
4522%     case lists:keysearch(simpletable,1,Constraint) of
4523% 	{value,{_,#type{def=Ref}}} ->
4524% 	    %% This ObjectClassFieldType, which has a simple table
4525% 	    %% constraint, must pick a fixed type value, mustn't it ?
4526% 	    {ClassDef,[{_,ClassFieldName}]} = Type#type.def,
4527% 	    ST =
4528% 		case Ref of
4529% 		    #'Externaltypereference'{module=M,type=ObjSetName} ->
4530% 			{[Name|Path],ObjSetName,ClassFieldName};
4531% 		    _ ->
4532% 			{[Name|Path],Ref,ClassFieldName}
4533% 		end,
4534% 	    any_simple_table(S,Cs,[ST|Acc]);
4535% 	false ->
4536% 	    any_simple_table(S,Cs,Acc)
4537%     end;
4538% any_simple_table(_,[],Acc) ->
4539%     lists:reverse(Acc);
4540% any_simple_table(S,[_|Cs],Acc) ->
4541%     any_simple_table(S,Cs,Acc).
4542
4543%% get_simple_table_if_used/2 searches the structure of Cs for any
4544%% component relation constraints due to the present level of the
4545%% structure. If there are any, the necessary information for code
4546%% generation of the look up functionality in the object set table are
4547%% returned.
4548get_simple_table_if_used(S,Cs) ->
4549    CNames = lists:map(fun(#'ComponentType'{name=Name}) -> Name;
4550			  (_) -> [] %% in case of extension marks
4551		       end,
4552		       Cs),
4553    RefedSimpleTable=any_component_relation(S,Cs,CNames,[],[]),
4554    get_simple_table_info(S,Cs,remove_doubles(RefedSimpleTable)).
4555
4556remove_doubles(L) ->
4557    remove_doubles(L,[]).
4558remove_doubles([H|T],Acc) ->
4559    NewT = remove_doubles1(H,T),
4560    remove_doubles(NewT,[H|Acc]);
4561remove_doubles([],Acc) ->
4562    Acc.
4563
4564remove_doubles1(El,L) ->
4565    case lists:delete(El,L) of
4566	L -> L;
4567	NewL -> remove_doubles1(El,NewL)
4568    end.
4569
4570%% get_simple_table_info searches the commponents Cs by the path from
4571%% an at-list (third argument), and follows into a component of it if
4572%% necessary, to get information needed for code generating.
4573%%
4574%% Returns a list of tuples with three elements. It holds a list of
4575%% atoms that is the path, the name of the field of the class that are
4576%% referred to in the ObjectClassFieldType, and the name of the unique
4577%% field of the class of the ObjectClassFieldType.
4578%%
4579% %% The level information outermost/innermost must be kept. There are
4580% %% at least two possibilities to cover here for an outermost case: 1)
4581% %% Both the simple table and the component relation have a common path
4582% %% at least one step below the outermost level, i.e. the leading
4583% %% information shall be on a sub level. 2) They don't have any common
4584% %% path.
4585get_simple_table_info(S,Cs,[AtList|Rest]) ->
4586%%    [get_simple_table_info1(S,Cs,AtList,S#state.abscomppath)|get_simple_table_info(S,Cs,Rest)];
4587    [get_simple_table_info1(S,Cs,AtList,[])|get_simple_table_info(S,Cs,Rest)];
4588get_simple_table_info(_,_,[]) ->
4589    [].
4590get_simple_table_info1(S,Cs,[Cname|Cnames],Path) when list(Cs) ->
4591    case lists:keysearch(Cname,#'ComponentType'.name,Cs) of
4592	{value,C} ->
4593	    get_simple_table_info1(S,C,Cnames,[Cname|Path]);
4594        _ ->
4595	    error({type,"Missing expected simple table constraint",S})
4596    end;
4597get_simple_table_info1(S,#'ComponentType'{typespec=TS},[],Path) ->
4598    %% In this component there must be a simple table constraint
4599    %% o.w. the asn1 code is wrong.
4600    #type{def=OCFT,constraint=Cnstr} = TS,
4601    case Cnstr of
4602	[{simpletable,_OSRef}] ->
4603	    #'ObjectClassFieldType'{classname=ClRef,
4604				    class=ObjectClass,
4605				    fieldname=FieldName} = OCFT,
4606%	    #'ObjectClassFieldType'{ObjectClass,FieldType} = ObjectClassFieldType,
4607	    ObjectClassFieldName =
4608		case FieldName of
4609		    {LastFieldName,[]} -> LastFieldName;
4610		    {_FirstFieldName,FieldNames} ->
4611			lists:last(FieldNames)
4612		end,
4613	    %%ObjectClassFieldName is the last element in the dotted
4614	    %%list of the ObjectClassFieldType. The last element may
4615	    %%be of another class, that is referenced from the class
4616	    %%of the ObjectClassFieldType
4617	    ClassDef =
4618		case ObjectClass of
4619		    [] ->
4620			{_,CDef}=get_referenced_type(S,ClRef),
4621			CDef;
4622		    _ -> #classdef{typespec=ObjectClass}
4623		end,
4624	    UniqueName =
4625		case (catch get_unique_fieldname(ClassDef)) of
4626		    {error,'__undefined_'} -> no_unique;
4627		    {asn1,Msg,_} ->
4628			error({type,Msg,S});
4629		    Other -> Other
4630		end,
4631	    {lists:reverse(Path),ObjectClassFieldName,UniqueName};
4632	_ ->
4633	    error({type,{asn1,"missing expected simple table constraint",
4634			 Cnstr},S})
4635    end;
4636get_simple_table_info1(S,#'ComponentType'{typespec=TS},Cnames,Path) ->
4637    Components = get_atlist_components(TS#type.def),
4638    get_simple_table_info1(S,Components,Cnames,Path).
4639
4640%% any_component_relation searches for all component relation
4641%% constraints that refers to the actual level and returns a list of
4642%% the "name path" in the at-list to the component relation constraint
4643%% that must refer to a simple table constraint. The list is empty if
4644%% no component relation constraints were found.
4645%%
4646%% NamePath has the names of all components that are followed from the
4647%% beginning of the search. CNames holds the names of all components
4648%% of the start level, this info is used if an outermost at-notation
4649%% is found to check the validity of the at-list.
4650any_component_relation(S,[C|Cs],CNames,NamePath,Acc) ->
4651    CName = C#'ComponentType'.name,
4652    Type = C#'ComponentType'.typespec,
4653    CRelPath =
4654	case Type#type.constraint of
4655	    [{componentrelation,_,AtNotation}] ->
4656		%% Found component relation constraint, now check
4657		%% whether this constraint is relevant for the level
4658		%% where the search started
4659		AtNot = extract_at_notation(AtNotation),
4660		%% evaluate_atpath returns the relative path to the
4661		%% simple table constraint from where the component
4662		%% relation is found.
4663		evaluate_atpath(S#state.abscomppath,NamePath,CNames,AtNot);
4664	    _ ->
4665		[]
4666	end,
4667    InnerAcc =
4668	case {Type#type.inlined,
4669	      asn1ct_gen:type(asn1ct_gen:get_inner(Type#type.def))} of
4670	    {no,{constructed,bif}} ->
4671		InnerCs =
4672		    case get_components(Type#type.def) of
4673			{IC1,_IC2} -> IC1 ++ IC1;
4674			IC -> IC
4675		    end,
4676		%% here we are interested in components of an
4677		%% SEQUENCE/SET OF as well as SEQUENCE, SET and CHOICE
4678		any_component_relation(S,InnerCs,CNames,[CName|NamePath],[]);
4679	    _ ->
4680		[]
4681	end,
4682    any_component_relation(S,Cs,CNames,NamePath,InnerAcc++CRelPath++Acc);
4683any_component_relation(_,[],_,_,Acc) ->
4684    Acc.
4685
4686%% evaluate_atpath/4 finds out whether the at notation refers to the
4687%% search level. The list of referenced names in the AtNot list shall
4688%% begin with a name that exists on the level it refers to. If the
4689%% found AtPath is referring to the same sub-branch as the simple table
4690%% has, then there shall not be any leading attribute info on this
4691%% level.
4692evaluate_atpath(_,[],Cnames,{innermost,AtPath=[Ref|_Refs]}) ->
4693    %% any innermost constraint found deeper in the structure is
4694    %% ignored.
4695    case lists:member(Ref,Cnames) of
4696	true -> [AtPath];
4697	false -> []
4698    end;
4699%% In this case must check that the AtPath doesn't step any step of
4700%% the NamePath, in that case the constraint will be handled in an
4701%% inner level.
4702evaluate_atpath(TopPath,NamePath,Cnames,{outermost,AtPath=[_Ref|_Refs]}) ->
4703    AtPathBelowTop =
4704	case TopPath of
4705	    [] -> AtPath;
4706	    _ ->
4707		case lists:prefix(TopPath,AtPath) of
4708		    true ->
4709			lists:subtract(AtPath,TopPath);
4710		    _ -> []
4711		end
4712	end,
4713    case {NamePath,AtPathBelowTop} of
4714	{[H|_T1],[H|_T2]} -> []; % this must be handled in lower level
4715	{_,[]} -> [];% this must be handled in an above level
4716	{_,[H|_T]} ->
4717	    case lists:member(H,Cnames) of
4718		true -> [AtPathBelowTop];
4719		_ -> error({type,{asn1,"failed to analyze at-path",AtPath}})
4720	    end
4721    end;
4722evaluate_atpath(_,_,_,_) ->
4723    [].
4724
4725%% Type may be any of SEQUENCE, SET, CHOICE, SEQUENCE OF, SET OF but
4726%% only the three first have valid components.
4727get_atlist_components(Def) ->
4728    get_components(atlist,Def).
4729
4730get_components(Def) ->
4731    get_components(any,Def).
4732
4733get_components(_,#'SEQUENCE'{components=Cs}) ->
4734    Cs;
4735get_components(_,#'SET'{components=Cs}) ->
4736    Cs;
4737get_components(_,{'CHOICE',Cs}) ->
4738    Cs;
4739get_components(any,{'SEQUENCE OF',#type{def=Def}}) ->
4740    get_components(any,Def);
4741get_components(any,{'SET OF',#type{def=Def}}) ->
4742    get_components(any,Def);
4743get_components(_,_) ->
4744    [].
4745
4746
4747extract_at_notation([{Level,[#'Externalvaluereference'{value=Name}|Rest]}]) ->
4748    {Level,[Name|extract_at_notation1(Rest)]};
4749extract_at_notation(At) ->
4750    exit({error,{asn1,{at_notation,At}}}).
4751extract_at_notation1([#'Externalvaluereference'{value=Name}|Rest]) ->
4752    [Name|extract_at_notation1(Rest)];
4753extract_at_notation1([]) ->
4754    [].
4755
4756%% componentrelation1/1 identifies all componentrelation constraints
4757%% that exist in C or in the substructure of C. Info about the found
4758%% constraints are returned in a list. It is ObjectSet, the reference
4759%% to the object set, AttrPath, the name atoms extracted from the
4760%% at-list in the component relation constraint, ClassDef, the
4761%% objectclass record of the class of the ObjectClassFieldType, Path,
4762%% that is the component name "path" from the searched level to this
4763%% constraint.
4764%%
4765%% The function is called with one component of the type in turn and
4766%% with the component name in Path at the first call. When called from
4767%% within, the name of the inner component is added to Path.
4768componentrelation1(S,C = #type{def=Def,constraint=Constraint,tablecinf=TCI},
4769		   Path) ->
4770    Ret =
4771	case Constraint of
4772	    [{componentrelation,{_,_,ObjectSet},AtList}|_Rest] ->
4773		[{_,AL=[#'Externalvaluereference'{}|_R1]}|_R2] = AtList,
4774		%% Note: if Path is longer than one,i.e. it is within
4775		%% an inner type of the actual level, then the only
4776		%% relevant at-list is of "outermost" type.
4777%%		#'ObjectClassFieldType'{class=ClassDef} = Def,
4778		ClassDef = get_ObjectClassFieldType_classdef(S,Def),
4779		AtPath =
4780		    lists:map(fun(#'Externalvaluereference'{value=V})->V end,
4781			      AL),
4782		{[{ObjectSet,AtPath,ClassDef,Path}],Def};
4783	    _Other ->
4784		%% check the inner type of component
4785		innertype_comprel(S,Def,Path)
4786	end,
4787    case Ret of
4788	nofunobj ->
4789	    nofunobj; %% ignored by caller
4790	{CRelI=[{ObjSet,_,_,_}],NewDef} -> %%
4791	    TCItmp = lists:subtract(TCI,[{objfun,ObjSet}]),
4792	    {CRelI,C#type{tablecinf=[{objfun,ObjSet}|TCItmp],def=NewDef}};
4793	{CompRelInf,NewDef} -> %% more than one tuple in CompRelInf
4794	    TCItmp = lists:subtract(TCI,[{objfun,anyset}]),
4795	    {CompRelInf,C#type{tablecinf=[{objfun,anyset}|TCItmp],def=NewDef}}
4796    end.
4797
4798innertype_comprel(S,{'SEQUENCE OF',Type},Path) ->
4799    case innertype_comprel1(S,Type,Path) of
4800	nofunobj ->
4801	    nofunobj;
4802	{CompRelInf,NewType} ->
4803	    {CompRelInf,{'SEQUENCE OF',NewType}}
4804    end;
4805innertype_comprel(S,{'SET OF',Type},Path) ->
4806    case innertype_comprel1(S,Type,Path) of
4807	nofunobj ->
4808	    nofunobj;
4809	{CompRelInf,NewType} ->
4810	    {CompRelInf,{'SET OF',NewType}}
4811    end;
4812innertype_comprel(S,{'CHOICE',CTypeList},Path) ->
4813    case componentlist_comprel(S,CTypeList,[],Path,[]) of
4814	nofunobj ->
4815	    nofunobj;
4816	{CompRelInf,NewCs} ->
4817	    {CompRelInf,{'CHOICE',NewCs}}
4818    end;
4819innertype_comprel(S,Seq = #'SEQUENCE'{components=Cs},Path) ->
4820    case componentlist_comprel(S,Cs,[],Path,[]) of
4821	nofunobj ->
4822	    nofunobj;
4823	{CompRelInf,NewCs} ->
4824	    {CompRelInf,Seq#'SEQUENCE'{components=NewCs}}
4825    end;
4826innertype_comprel(S,Set = #'SET'{components=Cs},Path) ->
4827    case componentlist_comprel(S,Cs,[],Path,[]) of
4828	nofunobj ->
4829	    nofunobj;
4830	{CompRelInf,NewCs} ->
4831	    {CompRelInf,Set#'SET'{components=NewCs}}
4832    end;
4833innertype_comprel(_,_,_) ->
4834    nofunobj.
4835
4836componentlist_comprel(S,[C = #'ComponentType'{name=Name,typespec=Type}|Cs],
4837		      Acc,Path,NewCL) ->
4838    case catch componentrelation1(S,Type,Path++[Name]) of
4839	{'EXIT',_} ->
4840	    componentlist_comprel(S,Cs,Acc,Path,[C|NewCL]);
4841	nofunobj ->
4842	    componentlist_comprel(S,Cs,Acc,Path,[C|NewCL]);
4843	{CRelInf,NewType} ->
4844	    componentlist_comprel(S,Cs,CRelInf++Acc,Path,
4845				  [C#'ComponentType'{typespec=NewType}|NewCL])
4846    end;
4847componentlist_comprel(_,[],Acc,_,NewCL) ->
4848    case Acc of
4849	[] ->
4850	    nofunobj;
4851	_ ->
4852	    {Acc,lists:reverse(NewCL)}
4853    end.
4854
4855innertype_comprel1(S,T = #type{def=Def,constraint=Cons,tablecinf=TCI},Path) ->
4856    Ret =
4857	case Cons of
4858	    [{componentrelation,{_,_,ObjectSet},AtList}|_Rest] ->
4859		%% This AtList must have an "outermost" at sign to be
4860		%% relevant here.
4861		[{_,AL=[#'Externalvaluereference'{value=_Attr}|_R1]}|_R2]
4862		    = AtList,
4863%%		#'ObjectClassFieldType'{class=ClassDef} = Def,
4864		ClassDef = get_ObjectClassFieldType_classdef(S,Def),
4865		AtPath =
4866		    lists:map(fun(#'Externalvaluereference'{value=V})->V end,
4867			      AL),
4868		[{ObjectSet,AtPath,ClassDef,Path}];
4869	    _ ->
4870		innertype_comprel(S,Def,Path)
4871	end,
4872    case Ret of
4873	nofunobj -> nofunobj;
4874	L = [{ObjSet,_,_,_}] ->
4875	    TCItmp = lists:subtract(TCI,[{objfun,ObjSet}]),
4876	    {L,T#type{tablecinf=[{objfun,ObjSet}|TCItmp]}};
4877	{CRelInf,NewDef} ->
4878	    TCItmp = lists:subtract(TCI,[{objfun,anyset}]),
4879	    {CRelInf,T#type{def=NewDef,tablecinf=[{objfun,anyset}|TCItmp]}}
4880    end.
4881
4882
4883%% leading_attr_index counts the index and picks the name of the
4884%% component that is at the actual level in the at-list of the
4885%% component relation constraint (AttrP).  AbsP is the path of
4886%% component names from the top type level to the actual level. AttrP
4887%% is a list with the atoms from the at-list.
4888leading_attr_index(S,Cs,[H={_,AttrP,_,_}|T],AbsP,Acc) ->
4889    AttrInfo =
4890	case lists:prefix(AbsP,AttrP) of
4891	    %% why this ?? It is necessary when in same situation as
4892	    %% TConstrChoice, there is an inner structure with an
4893	    %% outermost at-list and the "leading attribute" code gen
4894	    %% may be at a level some steps below the outermost level.
4895	    true ->
4896		RelativAttrP = lists:subtract(AttrP,AbsP),
4897		%% The header is used to calculate the index of the
4898		%% component and to give the fun, received from the
4899		%% object set look up, an unique name. The tail is
4900		%% used to match the proper value input to the fun.
4901		{hd(RelativAttrP),tl(RelativAttrP)};
4902	    false ->
4903		{hd(AttrP),tl(AttrP)}
4904	end,
4905    case leading_attr_index1(S,Cs,H,AttrInfo,1) of
4906	0 ->
4907	    leading_attr_index(S,Cs,T,AbsP,Acc);
4908	Res ->
4909	    leading_attr_index(S,Cs,T,AbsP,[Res|Acc])
4910    end;
4911leading_attr_index(_,_Cs,[],_,Acc) ->
4912    lists:reverse(Acc).
4913
4914leading_attr_index1(_,[],_,_,_) ->
4915    0;
4916leading_attr_index1(S,[C|Cs],Arg={ObjectSet,_,CDef,P},
4917		    AttrInfo={Attr,SubAttr},N) ->
4918    case C#'ComponentType'.name of
4919	Attr ->
4920	    ValueMatch = value_match(S,C,Attr,SubAttr),
4921	    {ObjectSet,Attr,N,CDef,P,ValueMatch};
4922	_ ->
4923	    leading_attr_index1(S,Cs,Arg,AttrInfo,N+1)
4924    end.
4925
4926%% value_math gathers information for a proper value match in the
4927%% generated encode function. For a SEQUENCE or a SET the index of the
4928%% component is counted. For a CHOICE the index is 2.
4929value_match(S,C,Name,SubAttr) ->
4930    value_match(S,C,Name,SubAttr,[]). % C has name Name
4931value_match(_S,#'ComponentType'{},_Name,[],Acc) ->
4932    Acc;% do not reverse, indexes in reverse order
4933value_match(S,#'ComponentType'{typespec=Type},Name,[At|Ats],Acc) ->
4934    InnerType = asn1ct_gen:get_inner(Type#type.def),
4935    Components =
4936	case get_atlist_components(Type#type.def) of
4937	    [] -> error({type,{asn1,"element in at list must be a "
4938			       "SEQUENCE, SET or CHOICE.",Name},S});
4939	    Comps -> Comps
4940	end,
4941    {Index,ValueIndex} = component_value_index(S,InnerType,At,Components),
4942    value_match(S,lists:nth(Index,Components),At,Ats,[ValueIndex|Acc]).
4943
4944component_value_index(S,'CHOICE',At,Components) ->
4945    {component_index(S,At,Components),2};
4946component_value_index(S,_,At,Components) ->
4947    %% SEQUENCE or SET
4948    Index = component_index(S,At,Components),
4949    {Index,{Index+1,At}}.
4950
4951component_index(S,Name,Components) ->
4952    component_index1(S,Name,Components,1).
4953component_index1(_S,Name,[#'ComponentType'{name=Name}|_Cs],N) ->
4954    N;
4955component_index1(S,Name,[_C|Cs],N) ->
4956    component_index1(S,Name,Cs,N+1);
4957component_index1(S,Name,[],_) ->
4958    error({type,{asn1,"component of at-list was not"
4959		 " found in substructure",Name},S}).
4960
4961get_unique_fieldname(ClassDef) ->
4962%%    {_,Fields,_} = ClassDef#classdef.typespec,
4963    Fields = (ClassDef#classdef.typespec)#objectclass.fields,
4964    get_unique_fieldname(Fields,[]).
4965
4966get_unique_fieldname([],[]) ->
4967    throw({error,'__undefined_'});
4968get_unique_fieldname([],[Name]) ->
4969    Name;
4970get_unique_fieldname([],Acc) ->
4971    throw({asn1,'only one UNIQUE field is allowed in CLASS',Acc});
4972get_unique_fieldname([{fixedtypevaluefield,Name,_,'UNIQUE',_}|Rest],Acc) ->
4973    get_unique_fieldname(Rest,[Name|Acc]);
4974get_unique_fieldname([_H|T],Acc) ->
4975    get_unique_fieldname(T,Acc).
4976
4977get_tableconstraint_info(S,Type,{CheckedTs,EComps}) ->
4978    {get_tableconstraint_info(S,Type,CheckedTs,[]),
4979     get_tableconstraint_info(S,Type,EComps,[])};
4980get_tableconstraint_info(S,Type,CheckedTs) ->
4981    get_tableconstraint_info(S,Type,CheckedTs,[]).
4982
4983get_tableconstraint_info(_S,_Type,[],Acc) ->
4984    lists:reverse(Acc);
4985get_tableconstraint_info(S,Type,[C|Cs],Acc) ->
4986    CheckedTs = C#'ComponentType'.typespec,
4987    AccComp =
4988	case CheckedTs#type.def of
4989	    %% ObjectClassFieldType
4990	    OCFT=#'ObjectClassFieldType'{class=#objectclass{},
4991					 type=_AType} ->
4992%		AType = get_ObjectClassFieldType(S,Fields,FieldRef),
4993%		RefedFieldName =
4994%		    get_referencedclassfield(CheckedTs#type.def),%is probably obsolete
4995		NewOCFT =
4996		    OCFT#'ObjectClassFieldType'{class=[]},
4997		C#'ComponentType'{typespec=
4998				  CheckedTs#type{
4999%				    def=AType,
5000				    def=NewOCFT
5001				    }};
5002%				    constraint=[{tableconstraint_info,
5003%						 FieldRef}]}};
5004	    {'SEQUENCE OF',SOType} when record(SOType,type),
5005					(element(1,SOType#type.def)=='CHOICE') ->
5006		CTypeList = element(2,SOType#type.def),
5007		NewInnerCList =
5008		    get_tableconstraint_info(S,Type,CTypeList,[]),
5009		C#'ComponentType'{typespec=
5010				  CheckedTs#type{
5011				    def={'SEQUENCE OF',
5012					 SOType#type{def={'CHOICE',
5013							  NewInnerCList}}}}};
5014	    {'SET OF',SOType} when record(SOType,type),
5015				   (element(1,SOType#type.def)=='CHOICE') ->
5016		CTypeList = element(2,SOType#type.def),
5017		NewInnerCList =
5018		    get_tableconstraint_info(S,Type,CTypeList,[]),
5019		C#'ComponentType'{typespec=
5020				  CheckedTs#type{
5021				    def={'SET OF',
5022					 SOType#type{def={'CHOICE',
5023							  NewInnerCList}}}}};
5024	    _ ->
5025		C
5026	end,
5027    get_tableconstraint_info(S,Type,Cs,[AccComp|Acc]).
5028
5029get_referenced_fieldname([{_,FirstFieldname}]) ->
5030    {FirstFieldname,[]};
5031get_referenced_fieldname([{_,FirstFieldname}|Rest]) ->
5032    {FirstFieldname,lists:map(fun(X)->element(2,X) end,Rest)};
5033get_referenced_fieldname(Def) ->
5034    {no_type,Def}.
5035
5036%% get_ObjectClassFieldType extracts the type from the chain of
5037%% objects that leads to a final type.
5038get_ObjectClassFieldType(S,ERef,PrimFieldNameList) when
5039  record(ERef,'Externaltypereference') ->
5040    {_,Type} = get_referenced_type(S,ERef),
5041    ClassSpec = check_class(S,Type),
5042    Fields = ClassSpec#objectclass.fields,
5043    get_ObjectClassFieldType(S,Fields,PrimFieldNameList);
5044get_ObjectClassFieldType(S,Fields,L=[_PrimFieldName1|_Rest]) ->
5045    check_PrimitiveFieldNames(S,Fields,L),
5046    get_OCFType(S,Fields,L).
5047
5048check_PrimitiveFieldNames(_S,_Fields,_) ->
5049    ok.
5050
5051%% get_ObjectClassFieldType_classdef gets the def of the class of the
5052%% ObjectClassFieldType, i.e. the objectclass record. If the type has
5053%% been checked (it may be a field type of an internal SEQUENCE) the
5054%% class field = [], then the classdef has to be fetched by help of
5055%% the class reference in the classname field.
5056get_ObjectClassFieldType_classdef(S,#'ObjectClassFieldType'{classname=Name,
5057							  class=[]}) ->
5058    {_,#classdef{typespec=TS}} = get_referenced_type(S,Name),
5059    TS;
5060get_ObjectClassFieldType_classdef(_,#'ObjectClassFieldType'{class=Cl}) ->
5061    Cl.
5062
5063get_OCFType(S,Fields,[{_FieldType,PrimFieldName}|Rest]) ->
5064    case lists:keysearch(PrimFieldName,2,Fields) of
5065	{value,{fixedtypevaluefield,_,Type,_Unique,_OptSpec}} ->
5066	    {fixedtypevaluefield,PrimFieldName,Type};
5067	{value,{objectfield,_,Type,_Unique,_OptSpec}} ->
5068	    {_,ClassDef} = get_referenced_type(S,Type#type.def),
5069	    CheckedCDef = check_class(S#state{type=ClassDef,
5070					      tname=ClassDef#classdef.name},
5071				      ClassDef#classdef.typespec),
5072	    get_OCFType(S,CheckedCDef#objectclass.fields,Rest);
5073	{value,{objectsetfield,_,Type,_OptSpec}} ->
5074	    {_,ClassDef} = get_referenced_type(S,Type#type.def),
5075	    CheckedCDef = check_class(S#state{type=ClassDef,
5076					      tname=ClassDef#classdef.name},
5077				      ClassDef#classdef.typespec),
5078	    get_OCFType(S,CheckedCDef#objectclass.fields,Rest);
5079
5080	{value,Other} ->
5081	    {element(1,Other),PrimFieldName};
5082	_  ->
5083	    error({type,"undefined FieldName in ObjectClassFieldType",S})
5084    end.
5085
5086get_taglist(#state{erule=per},_) ->
5087    [];
5088get_taglist(#state{erule=per_bin},_) ->
5089    [];
5090get_taglist(S,Ext) when record(Ext,'Externaltypereference') ->
5091    {_,T} = get_referenced_type(S,Ext),
5092    get_taglist(S,T#typedef.typespec);
5093get_taglist(S,Tref) when record(Tref,typereference) ->
5094    {_,T} = get_referenced_type(S,Tref),
5095    get_taglist(S,T#typedef.typespec);
5096get_taglist(S,Type) when record(Type,type) ->
5097    case Type#type.tag of
5098	[] ->
5099	    get_taglist(S,Type#type.def);
5100	[Tag|_]  ->
5101% 	    case lists:member(S#state.erule,[ber,ber_bin]) of
5102% 		true ->
5103% 		   lists:map(fun(Tx) -> asn1ct_gen:def_to_tag(Tx) end,Type#type.tag);
5104% 		_ ->
5105	    [asn1ct_gen:def_to_tag(Tag)]
5106%	    end
5107    end;
5108get_taglist(S,{'CHOICE',{Rc,Ec}}) ->
5109    get_taglist(S,{'CHOICE',Rc ++ Ec});
5110get_taglist(S,{'CHOICE',Components}) ->
5111    get_taglist1(S,Components);
5112%% ObjectClassFieldType OTP-4390
5113get_taglist(_S,#'ObjectClassFieldType'{type={typefield,_}}) ->
5114    [];
5115get_taglist(S,#'ObjectClassFieldType'{type={fixedtypevaluefield,_,Type}}) ->
5116    get_taglist(S,Type);
5117get_taglist(S,{ERef=#'Externaltypereference'{},FieldNameList})
5118  when list(FieldNameList) ->
5119    case get_ObjectClassFieldType(S,ERef,FieldNameList) of
5120	Type when record(Type,type) ->
5121	    get_taglist(S,Type);
5122	{fixedtypevaluefield,_,Type} -> get_taglist(S,Type);
5123	{TypeFieldName,_} when atom(TypeFieldName) -> []%should check if allowed
5124    end;
5125get_taglist(S,{ObjCl,FieldNameList}) when record(ObjCl,objectclass),
5126					  list(FieldNameList) ->
5127    case get_ObjectClassFieldType(S,ObjCl#objectclass.fields,FieldNameList) of
5128	Type when record(Type,type) ->
5129	    get_taglist(S,Type);
5130	{fixedtypevaluefield,_,Type} -> get_taglist(S,Type);
5131	{TypeFieldName,_} when atom(TypeFieldName) -> []%should check if allowed
5132    end;
5133get_taglist(S,Def) ->
5134    case lists:member(S#state.erule,[ber_bin_v2]) of
5135	false ->
5136	    case Def of
5137		'ASN1_OPEN_TYPE' -> % open_type has no UNIVERSAL tag as such
5138		    [];
5139		_ ->
5140		    [asn1ct_gen:def_to_tag(Def)]
5141	    end;
5142	_ ->
5143	    []
5144    end.
5145
5146get_taglist1(S,[#'ComponentType'{name=_Cname,tags=TagL}|Rest]) when list(TagL) ->
5147    %% tag_list has been here , just return TagL and continue with next alternative
5148    TagL ++ get_taglist1(S,Rest);
5149get_taglist1(S,[#'ComponentType'{typespec=Ts,tags=undefined}|Rest]) ->
5150    get_taglist(S,Ts) ++ get_taglist1(S,Rest);
5151get_taglist1(S,[_H|Rest]) -> % skip EXTENSIONMARK
5152    get_taglist1(S,Rest);
5153get_taglist1(_S,[]) ->
5154    [].
5155
5156dbget_ex(_S,Module,Key) ->
5157    case asn1_db:dbget(Module,Key) of
5158	undefined ->
5159
5160	    throw({error,{asn1,{undefined,{Module,Key}}}}); % this is catched on toplevel type or value
5161	T -> T
5162    end.
5163
5164merge_tags(T1, T2) when list(T2) ->
5165    merge_tags2(T1 ++ T2, []);
5166merge_tags(T1, T2) ->
5167    merge_tags2(T1 ++ [T2], []).
5168
5169merge_tags2([T1= #tag{type='IMPLICIT'}, T2 |Rest], Acc) ->
5170    merge_tags2([T1#tag{type=T2#tag.type, form=T2#tag.form}|Rest],Acc);
5171merge_tags2([T1= #tag{type={default,'IMPLICIT'}}, T2 |Rest], Acc) ->
5172    merge_tags2([T1#tag{type=T2#tag.type, form=T2#tag.form}|Rest],Acc);
5173merge_tags2([H|T],Acc) ->
5174    merge_tags2(T, [H|Acc]);
5175merge_tags2([], Acc) ->
5176    lists:reverse(Acc).
5177
5178merge_constraints(C1, []) ->
5179    C1;
5180merge_constraints([], C2) ->
5181    C2;
5182merge_constraints(C1, C2) ->
5183    {SList,VList,PAList,Rest} = splitlist(C1++C2,[],[],[],[]),
5184    SizeC = merge_constraints(SList),
5185    ValueC = merge_constraints(VList),
5186    PermAlphaC = merge_constraints(PAList),
5187    case Rest of
5188        [] ->
5189            SizeC ++ ValueC ++ PermAlphaC;
5190        _ ->
5191            throw({error,{asn1,{not_implemented,{merge_constraints,Rest}}}})
5192    end.
5193
5194merge_constraints([]) -> [];
5195merge_constraints([C1 = {_,{Low1,High1}},{_,{Low2,High2}}|Rest]) when Low1 >= Low2,
5196                                                                      High1 =< High2 ->
5197    merge_constraints([C1|Rest]);
5198merge_constraints([C1={'PermittedAlphabet',_},C2|Rest]) ->
5199    [C1|merge_constraints([C2|Rest])];
5200merge_constraints([C1 = {_,{_Low1,_High1}},C2 = {_,{_Low2,_High2}}|_Rest]) ->
5201    throw({error,asn1,{conflicting_constraints,{C1,C2}}});
5202merge_constraints([C]) ->
5203    [C].
5204
5205splitlist([C={'SizeConstraint',_}|Rest],Sacc,Vacc,PAacc,Restacc) ->
5206    splitlist(Rest,[C|Sacc],Vacc,PAacc,Restacc);
5207splitlist([C={'ValueRange',_}|Rest],Sacc,Vacc,PAacc,Restacc) ->
5208    splitlist(Rest,Sacc,[C|Vacc],PAacc,Restacc);
5209splitlist([C={'PermittedAlphabet',_}|Rest],Sacc,Vacc,PAacc,Restacc) ->
5210    splitlist(Rest,Sacc,Vacc,[C|PAacc],Restacc);
5211splitlist([C|Rest],Sacc,Vacc,PAacc,Restacc) ->
5212    splitlist(Rest,Sacc,Vacc,PAacc,[C|Restacc]);
5213splitlist([],Sacc,Vacc,PAacc,Restacc) ->
5214    {lists:reverse(Sacc),
5215     lists:reverse(Vacc),
5216     lists:reverse(PAacc),
5217     lists:reverse(Restacc)}.
5218
5219
5220
5221storeindb(M) when record(M,module) ->
5222    TVlist = M#module.typeorval,
5223    NewM = M#module{typeorval=findtypes_and_values(TVlist)},
5224    asn1_db:dbnew(NewM#module.name),
5225    asn1_db:dbput(NewM#module.name,'MODULE',  NewM),
5226    Res = storeindb(NewM#module.name,TVlist,[]),
5227    include_default_class(NewM#module.name),
5228    include_default_type(NewM#module.name),
5229    Res.
5230
5231storeindb(Module,[H|T],ErrAcc) when record(H,typedef) ->
5232    storeindb(Module,H#typedef.name,H,T,ErrAcc);
5233storeindb(Module,[H|T],ErrAcc) when record(H,valuedef) ->
5234    storeindb(Module,H#valuedef.name,H,T,ErrAcc);
5235storeindb(Module,[H|T],ErrAcc) when record(H,ptypedef) ->
5236    storeindb(Module,H#ptypedef.name,H,T,ErrAcc);
5237storeindb(Module,[H|T],ErrAcc) when record(H,classdef) ->
5238    storeindb(Module,H#classdef.name,H,T,ErrAcc);
5239storeindb(Module,[H|T],ErrAcc) when record(H,pvaluesetdef) ->
5240    storeindb(Module,H#pvaluesetdef.name,H,T,ErrAcc);
5241storeindb(Module,[H|T],ErrAcc) when record(H,pobjectdef) ->
5242    storeindb(Module,H#pobjectdef.name,H,T,ErrAcc);
5243storeindb(Module,[H|T],ErrAcc) when record(H,pvaluedef) ->
5244    storeindb(Module,H#pvaluedef.name,H,T,ErrAcc);
5245storeindb(_,[],[]) -> ok;
5246storeindb(_,[],ErrAcc) ->
5247    {error,ErrAcc}.
5248
5249storeindb(Module,Name,H,T,ErrAcc) ->
5250    case asn1_db:dbget(Module,Name) of
5251	undefined ->
5252	    asn1_db:dbput(Module,Name,H),
5253	    storeindb(Module,T,ErrAcc);
5254	_ ->
5255	    case H of
5256		_Type when record(H,typedef) ->
5257		    error({type,"already defined",
5258			   #state{mname=Module,type=H,tname=Name}});
5259		_Type when record(H,valuedef) ->
5260		    error({value,"already defined",
5261			   #state{mname=Module,value=H,vname=Name}});
5262		_Type when record(H,ptypedef) ->
5263		    error({ptype,"already defined",
5264			   #state{mname=Module,type=H,tname=Name}});
5265		_Type when record(H,pobjectdef) ->
5266		    error({ptype,"already defined",
5267			   #state{mname=Module,type=H,tname=Name}});
5268		_Type when record(H,pvaluesetdef) ->
5269		    error({ptype,"already defined",
5270			   #state{mname=Module,type=H,tname=Name}});
5271		_Type when record(H,pvaluedef) ->
5272		    error({ptype,"already defined",
5273			   #state{mname=Module,type=H,tname=Name}});
5274		_Type when record(H,classdef) ->
5275		    error({class,"already defined",
5276			   #state{mname=Module,value=H,vname=Name}})
5277	    end,
5278	    storeindb(Module,T,[H|ErrAcc])
5279    end.
5280
5281findtypes_and_values(TVList) ->
5282    findtypes_and_values(TVList,[],[],[],[],[],[]).%% Types,Values,
5283%% Parameterizedtypes,Classes,Objects and ObjectSets
5284
5285findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc)
5286  when record(H,typedef),record(H#typedef.typespec,'Object') ->
5287    findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,[H#typedef.name|Oacc],OSacc);
5288findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc)
5289  when record(H,typedef),record(H#typedef.typespec,'ObjectSet') ->
5290    findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,Oacc,[H#typedef.name|OSacc]);
5291findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc)
5292  when record(H,typedef) ->
5293    findtypes_and_values(T,[H#typedef.name|Tacc],Vacc,Pacc,Cacc,Oacc,OSacc);
5294findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc)
5295  when record(H,valuedef) ->
5296    findtypes_and_values(T,Tacc,[H#valuedef.name|Vacc],Pacc,Cacc,Oacc,OSacc);
5297findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc)
5298  when record(H,ptypedef) ->
5299    findtypes_and_values(T,Tacc,Vacc,[H#ptypedef.name|Pacc],Cacc,Oacc,OSacc);
5300findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc)
5301  when record(H,classdef) ->
5302    findtypes_and_values(T,Tacc,Vacc,Pacc,[H#classdef.name|Cacc],Oacc,OSacc);
5303findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc)
5304  when record(H,pvaluedef) ->
5305    findtypes_and_values(T,Tacc,[H#pvaluedef.name|Vacc],Pacc,Cacc,Oacc,OSacc);
5306findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc)
5307  when record(H,pvaluesetdef) ->
5308    findtypes_and_values(T,Tacc,[H#pvaluesetdef.name|Vacc],Pacc,Cacc,Oacc,OSacc);
5309findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc)
5310  when record(H,pobjectdef) ->
5311    findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,[H#pobjectdef.name|Oacc],OSacc);
5312findtypes_and_values([H|T],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc)
5313  when record(H,pobjectsetdef) ->
5314    findtypes_and_values(T,Tacc,Vacc,Pacc,Cacc,Oacc,[H#pobjectsetdef.name|OSacc]);
5315findtypes_and_values([],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) ->
5316    {lists:reverse(Tacc),lists:reverse(Vacc),lists:reverse(Pacc),
5317     lists:reverse(Cacc),lists:reverse(Oacc),lists:reverse(OSacc)}.
5318
5319
5320
5321error({export,Msg,#state{mname=Mname,type=Ref,tname=Typename}}) ->
5322    Pos = Ref#'Externaltypereference'.pos,
5323    io:format("asn1error:~p:~p:~p ~p~n",[Pos,Mname,Typename,Msg]),
5324    {error,{export,Pos,Mname,Typename,Msg}};
5325error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}})
5326  when record(Type,typedef) ->
5327    io:format("asn1error:~p:~p:~p ~p~n",
5328	      [Type#typedef.pos,Mname,Typename,Msg]),
5329    {error,{type,Type#typedef.pos,Mname,Typename,Msg}};
5330error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}})
5331  when record(Type,ptypedef) ->
5332    io:format("asn1error:~p:~p:~p ~p~n",
5333	      [Type#ptypedef.pos,Mname,Typename,Msg]),
5334    {error,{type,Type#ptypedef.pos,Mname,Typename,Msg}};
5335error({type,Msg,#state{mname=Mname,value=Value,vname=Valuename}})
5336  when record(Value,valuedef) ->
5337    io:format("asn1error:~p:~p:~p ~p~n",[Value#valuedef.pos,Mname,Valuename,Msg]),
5338    {error,{type,Value#valuedef.pos,Mname,Valuename,Msg}};
5339error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}})
5340  when record(Type,pobjectdef) ->
5341    io:format("asn1error:~p:~p:~p ~p~n",
5342	      [Type#pobjectdef.pos,Mname,Typename,Msg]),
5343    {error,{type,Type#pobjectdef.pos,Mname,Typename,Msg}};
5344error({value,Msg,#state{mname=Mname,value=Value,vname=Valuename}}) ->
5345    io:format("asn1error:~p:~p:~p ~p~n",[Value#valuedef.pos,Mname,Valuename,Msg]),
5346    {error,{value,Value#valuedef.pos,Mname,Valuename,Msg}};
5347error({Other,Msg,#state{mname=Mname,value=#valuedef{pos=Pos},vname=Valuename}}) ->
5348    io:format("asn1error:~p:~p:~p ~p~n",[Pos,Mname,Valuename,Msg]),
5349    {error,{Other,Pos,Mname,Valuename,Msg}};
5350error({Other,Msg,#state{mname=Mname,type=#typedef{pos=Pos},tname=Typename}}) ->
5351    io:format("asn1error:~p:~p:~p ~p~n",[Pos,Mname,Typename,Msg]),
5352    {error,{Other,Pos,Mname,Typename,Msg}};
5353error({Other,Msg,#state{mname=Mname,type=#classdef{pos=Pos},tname=Typename}}) ->
5354    io:format("asn1error:~p:~p:~p ~p~n",[Pos,Mname,Typename,Msg]),
5355    {error,{Other,Pos,Mname,Typename,Msg}}.
5356
5357include_default_type(Module) ->
5358    NameAbsList = default_type_list(),
5359    include_default_type1(Module,NameAbsList).
5360
5361include_default_type1(_,[]) ->
5362    ok;
5363include_default_type1(Module,[{Name,TS}|Rest]) ->
5364    case asn1_db:dbget(Module,Name) of
5365	undefined ->
5366	    T = #typedef{name=Name,
5367			 typespec=TS},
5368		asn1_db:dbput(Module,Name,T);
5369	_ -> ok
5370    end,
5371    include_default_type1(Module,Rest).
5372
5373default_type_list() ->
5374    %% The EXTERNAL type is represented, according to ASN.1 1997,
5375    %% as a SEQUENCE with components: identification, data-value-descriptor
5376    %% and data-value.
5377    Syntax =
5378	#'ComponentType'{name=syntax,
5379			 typespec=#type{def='OBJECT IDENTIFIER'},
5380			 prop=mandatory},
5381    Presentation_Cid =
5382	#'ComponentType'{name='presentation-context-id',
5383			 typespec=#type{def='INTEGER'},
5384			 prop=mandatory},
5385    Transfer_syntax =
5386	#'ComponentType'{name='transfer-syntax',
5387			 typespec=#type{def='OBJECT IDENTIFIER'},
5388			 prop=mandatory},
5389    Negotiation_items =
5390	#type{def=
5391	      #'SEQUENCE'{components=
5392			  [Presentation_Cid,
5393			   Transfer_syntax#'ComponentType'{prop=mandatory}]}},
5394    Context_negot =
5395	#'ComponentType'{name='context-negotiation',
5396			 typespec=Negotiation_items,
5397			 prop=mandatory},
5398
5399    Data_value_descriptor =
5400	#'ComponentType'{name='data-value-descriptor',
5401			 typespec=#type{def='ObjectDescriptor'},
5402			 prop='OPTIONAL'},
5403    Data_value =
5404	#'ComponentType'{name='data-value',
5405			 typespec=#type{def='OCTET STRING'},
5406			 prop=mandatory},
5407
5408    %% The EXTERNAL type is represented, according to ASN.1 1990,
5409    %% as a SEQUENCE with components: direct-reference, indirect-reference,
5410    %% data-value-descriptor and encoding.
5411
5412    Direct_reference =
5413	#'ComponentType'{name='direct-reference',
5414			 typespec=#type{def='OBJECT IDENTIFIER'},
5415			 prop='OPTIONAL'},
5416
5417    Indirect_reference =
5418	#'ComponentType'{name='indirect-reference',
5419			 typespec=#type{def='INTEGER'},
5420			 prop='OPTIONAL'},
5421
5422    Single_ASN1_type =
5423	#'ComponentType'{name='single-ASN1-type',
5424			 typespec=#type{tag=[{tag,'CONTEXT',0,
5425					      'EXPLICIT',32}],
5426					def='ANY'},
5427			 prop=mandatory},
5428
5429    Octet_aligned =
5430	#'ComponentType'{name='octet-aligned',
5431			 typespec=#type{tag=[{tag,'CONTEXT',1,
5432					      'IMPLICIT',32}],
5433					def='OCTET STRING'},
5434			 prop=mandatory},
5435
5436    Arbitrary =
5437	#'ComponentType'{name=arbitrary,
5438			 typespec=#type{tag=[{tag,'CONTEXT',2,
5439					      'IMPLICIT',32}],
5440					def={'BIT STRING',[]}},
5441			 prop=mandatory},
5442
5443    Encoding =
5444	#'ComponentType'{name=encoding,
5445			 typespec=#type{def={'CHOICE',
5446					     [Single_ASN1_type,Octet_aligned,
5447					      Arbitrary]}},
5448			 prop=mandatory},
5449
5450    EXTERNAL_components1990 =
5451	[Direct_reference,Indirect_reference,Data_value_descriptor,Encoding],
5452
5453    %% The EMBEDDED PDV type is represented by a SEQUENCE type
5454    %% with components: identification and data-value
5455    Abstract =
5456	#'ComponentType'{name=abstract,
5457			 typespec=#type{def='OBJECT IDENTIFIER'},
5458			 prop=mandatory},
5459    Transfer =
5460	#'ComponentType'{name=transfer,
5461			 typespec=#type{def='OBJECT IDENTIFIER'},
5462			 prop=mandatory},
5463    AbstractTrSeq =
5464	#'SEQUENCE'{components=[Abstract,Transfer]},
5465    Syntaxes =
5466	#'ComponentType'{name=syntaxes,
5467			 typespec=#type{def=AbstractTrSeq},
5468			 prop=mandatory},
5469    Fixed = #'ComponentType'{name=fixed,
5470			     typespec=#type{def='NULL'},
5471			     prop=mandatory},
5472    Negotiations =
5473	[Syntaxes,Syntax,Presentation_Cid,Context_negot,
5474	 Transfer_syntax,Fixed],
5475    Identification2 =
5476	#'ComponentType'{name=identification,
5477			 typespec=#type{def={'CHOICE',Negotiations}},
5478			 prop=mandatory},
5479    EmbeddedPdv_components =
5480	[Identification2,Data_value],
5481
5482    %% The CHARACTER STRING type is represented by a SEQUENCE type
5483    %% with components: identification and string-value
5484    String_value =
5485	#'ComponentType'{name='string-value',
5486			 typespec=#type{def='OCTET STRING'},
5487			 prop=mandatory},
5488    CharacterString_components =
5489	[Identification2,String_value],
5490
5491    [{'EXTERNAL',
5492      #type{tag=[#tag{class='UNIVERSAL',
5493		      number=8,
5494		      type='IMPLICIT',
5495		      form=32}],
5496	    def=#'SEQUENCE'{components=
5497			    EXTERNAL_components1990}}},
5498     {'EMBEDDED PDV',
5499      #type{tag=[#tag{class='UNIVERSAL',
5500		      number=11,
5501		      type='IMPLICIT',
5502		      form=32}],
5503	    def=#'SEQUENCE'{components=EmbeddedPdv_components}}},
5504     {'CHARACTER STRING',
5505      #type{tag=[#tag{class='UNIVERSAL',
5506		      number=29,
5507		      type='IMPLICIT',
5508		      form=32}],
5509	    def=#'SEQUENCE'{components=CharacterString_components}}}
5510     ].
5511
5512
5513include_default_class(Module) ->
5514    NameAbsList = default_class_list(),
5515    include_default_class1(Module,NameAbsList).
5516
5517include_default_class1(_,[]) ->
5518    ok;
5519include_default_class1(Module,[{Name,TS}|_Rest]) ->
5520    case asn1_db:dbget(Module,Name) of
5521	undefined ->
5522	    C = #classdef{checked=true,name=Name,
5523			  typespec=TS},
5524	    asn1_db:dbput(Module,Name,C);
5525	_ -> ok
5526    end.
5527
5528default_class_list() ->
5529    [{'TYPE-IDENTIFIER',
5530      {objectclass,
5531       [{fixedtypevaluefield,
5532	 id,
5533	 {type,[],'OBJECT IDENTIFIER',[]},
5534	 'UNIQUE',
5535	 'MANDATORY'},
5536	{typefield,'Type','MANDATORY'}],
5537       {'WITH SYNTAX',
5538	[{typefieldreference,'Type'},
5539	 'IDENTIFIED',
5540	 'BY',
5541	 {valuefieldreference,id}]}}},
5542     {'ABSTRACT-SYNTAX',
5543      {objectclass,
5544       [{fixedtypevaluefield,
5545	 id,
5546	 {type,[],'OBJECT IDENTIFIER',[]},
5547	 'UNIQUE',
5548	 'MANDATORY'},
5549	{typefield,'Type','MANDATORY'},
5550	{fixedtypevaluefield,
5551	 property,
5552	 {type,
5553	  [],
5554	  {'BIT STRING',[]},
5555	  []},
5556	 undefined,
5557	 {'DEFAULT',
5558	  [0,1,0]}}],
5559       {'WITH SYNTAX',
5560	[{typefieldreference,'Type'},
5561	 'IDENTIFIED',
5562	 'BY',
5563	 {valuefieldreference,id},
5564	 ['HAS',
5565	  'PROPERTY',
5566	  {valuefieldreference,property}]]}}}].
5567