aboutsummaryrefslogtreecommitdiffstats
path: root/lib/asn1/src/asn1ct_check.erl
diff options
context:
space:
mode:
authorBjörn Gustavsson <[email protected]>2013-06-04 06:03:50 +0200
committerBjörn Gustavsson <[email protected]>2013-06-04 06:03:50 +0200
commit2c6c863ef9a726fa2ae78e3d2fb7c577d60c3f36 (patch)
treef014f61ddee1bd1be0c1d19f64cf1d23e72244db /lib/asn1/src/asn1ct_check.erl
parent85f775093ab974128c629809e382891cb493073a (diff)
parent9be1fbb32ef0bbdf99c7c39fac4a845606156a23 (diff)
downloadotp-2c6c863ef9a726fa2ae78e3d2fb7c577d60c3f36.tar.gz
otp-2c6c863ef9a726fa2ae78e3d2fb7c577d60c3f36.tar.bz2
otp-2c6c863ef9a726fa2ae78e3d2fb7c577d60c3f36.zip
Merge branch 'bjorn/asn1/bug-fixes-and-clean-ups/OTP-11134' into maint
* bjorn/asn1/bug-fixes-and-clean-ups/OTP-11134: (77 commits) testSeqOf: Test constrained, extensible sizes Clean up testSeqOf Extend tests cases for BIT STRING Improve tests of ENUMERATED asn1ct_check: Eliminate useless Per argument from complist_as_tuple() asn1ct_check: Don't pass on #'ObjectClassFieldType'{} with fixed type asn1ct_gen_per: Remove useless renewal of 'enumval' Fix encoding of semi-constrained, extensible INTEGERs PER/UPER: Fix decoding of semi-constrained INTEGERs testPrim: Simplify test cases using a roundtrip function BER: Fix handling of a constructed default value for a class PER: Generate code for deep table constraints at compile-time Normalize data representation for table constraints asn1ct: Simplify check_value/2 Extend tests to cover more code in asn1ct_check Clean up checking of values for ENUMERATEDs Introduce a new mechanism for structured error handling asn1_db: Make dbput/3 and dbsave/2 asynchronous asn1_db: Remove unused functions asn1ct_check: Clean up checkc/3 ...
Diffstat (limited to 'lib/asn1/src/asn1ct_check.erl')
-rw-r--r--lib/asn1/src/asn1ct_check.erl970
1 files changed, 356 insertions, 614 deletions
diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl
index 0622998445..f94550b0a4 100644
--- a/lib/asn1/src/asn1ct_check.erl
+++ b/lib/asn1/src/asn1ct_check.erl
@@ -25,7 +25,7 @@
%-compile(export_all).
%% Avoid warning for local function error/1 clashing with autoimported BIF.
-compile({no_auto_import,[error/1]}).
--export([check/2,storeindb/2]).
+-export([check/2,storeindb/2,format_error/1]).
%-define(debug,1).
-include("asn1_records.hrl").
%%% The tag-number for universal types
@@ -73,7 +73,6 @@
end).
-record(newt,{type=unchanged,tag=unchanged,constraint=unchanged,inlined=no}). % used in check_type to update type and tag
--record(newv,{type=unchanged,value=unchanged}). % used in check_value to update type and value
check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) ->
%%Predicates used to filter errors
@@ -92,14 +91,14 @@ check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) ->
save_asn1db_uptodate(S,S#state.erule,S#state.mname),
put(top_module,S#state.mname),
- _Perror = checkp(S,ParameterizedTypes,[]), % must do this before the templates are used
+ _ = checkp(S, ParameterizedTypes), %must do this before the templates are used
%% table to save instances of parameterized objects,object sets
asn1ct_table:new(parameterized_objects),
asn1ct_table:new(inlined_objects),
- Terror = checkt(S,Types,[]),
+ Terror = checkt(S, Types),
?dbg("checkt finished with errors:~n~p~n~n",[Terror]),
%% get parameterized object sets sent to checkt/3
@@ -107,7 +106,7 @@ check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) ->
{PObjSetNames1,Terror2} = filter_errors(IsPObjSet,Terror),
- Verror = checkv(S,Values ++ ObjectSets,[]), %value sets may be parsed as object sets
+ Verror = checkv(S, Values ++ ObjectSets), %value sets may be parsed as object sets
?dbg("checkv finished with errors:~n~p~n~n",[Verror]),
%% get information object classes wrongly sent to checkt/3
%% and update Terror2
@@ -116,7 +115,7 @@ check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) ->
NewClasses = Classes++AddClasses,
- Cerror = checkc(S,NewClasses,[]),
+ Cerror = checkc(S, NewClasses),
?dbg("checkc finished with errors:~n~p~n~n",[Cerror]),
%% get object sets incorrectly sent to checkv/3
%% and update Verror
@@ -175,8 +174,9 @@ check(S,{Types,Values,ParameterizedTypes,Classes,Objects,ObjectSets}) ->
{NewTypes,NewValues,ParameterizedTypes,NewClasses,
lists:subtract(NewObjects,ExclO)++InlinedObjects,
lists:subtract(NewObjectSets,ExclOS)++ParObjectSetNames}};
- _ ->{error,{asn1,lists:flatten([Terror3,Verror5,Cerror,
- Oerror,Exporterror,ImportError])}}
+ _ ->
+ {error,lists:flatten([Terror3,Verror5,Cerror,
+ Oerror,Exporterror,ImportError])}
end.
context_switch_in_spec() ->
@@ -338,51 +338,40 @@ chained_import(S,ImpMod,DefMod,Name) ->
chained_import(S,OtherMod,DefMod,Name)
end
end.
-
-checkt(S,[Name|T],Acc) ->
- ?dbg("Checking type ~p~n",[Name]),
- Result =
- case asn1_db:dbget(S#state.mname,Name) of
- undefined ->
- error({type,{internal_error,'???'},S});
- Type when is_record(Type,typedef) ->
- NewS = S#state{type=Type,tname=Name},
- case catch(check_type(NewS,Type,Type#typedef.typespec)) of
- {error,Reason} ->
- error({type,Reason,NewS});
- {'EXIT',Reason} ->
- error({type,{internal_error,Reason},NewS});
- {asn1_class,_ClassDef} ->
- {asn1_class,Name};
- pobjectsetdef ->
- {pobjectsetdef,Name};
- pvalueset ->
- {pvalueset,Name};
- Ts ->
- case Type#typedef.checked of
- true -> % already checked and updated
- ok;
- _ ->
- NewTypeDef = Type#typedef{checked=true,typespec = Ts},
-
- asn1_db:dbput(NewS#state.mname,Name,NewTypeDef), % update the type
- ok
- end
- end
- end,
- case Result of
- ok ->
- checkt(S,T,Acc);
- _ ->
- checkt(S,T,[Result|Acc])
- end;
-checkt(S,[],Acc) ->
- case check_contextswitchingtypes(S,[]) of
- [] ->
- lists:reverse(Acc);
- L ->
- checkt(S,L,Acc)
+checkt(S0, Names) ->
+ Check = fun do_checkt/3,
+
+ %% NOTE: check_type/3 will store information in the process
+ %% dictionary if context switching types are encountered;
+ %% therefore we must force the evaluation order.
+ Types = check_fold(S0, Names, Check),
+ CtxtSwitch = check_contextswitchingtypes(S0, []),
+ check_fold(S0, lists:reverse(CtxtSwitch), Check) ++ Types.
+
+do_checkt(S, Name, #typedef{typespec=TypeSpec}=Type0) ->
+ NewS = S#state{type=Type0,tname=Name},
+ try check_type(NewS, Type0, TypeSpec) of
+ #type{}=Ts ->
+ case Type0#typedef.checked of
+ true -> %already checked and updated
+ ok;
+ _ ->
+ Type = Type0#typedef{checked=true,
+ typespec=Ts},
+ asn1_db:dbput(NewS#state.mname,
+ Name, Type),
+ ok
+ end
+ catch
+ {error,Reason} ->
+ error({type,Reason,NewS});
+ {asn1_class,_ClassDef} ->
+ {asn1_class,Name};
+ pobjectsetdef ->
+ {pobjectsetdef,Name};
+ pvalueset ->
+ {pvalueset,Name}
end.
check_contextswitchingtypes(S,Acc) ->
@@ -402,131 +391,86 @@ check_contextswitchingtypes(S,[{T,TName}|Ts],Acc) ->
check_contextswitchingtypes(_,[],Acc) ->
Acc.
-checkv(S,[Name|T],Acc) ->
- ?dbg("Checking valuedef ~p~n",[Name]),
- Result = case asn1_db:dbget(S#state.mname,Name) of
- undefined -> error({value,{internal_error,'???'},S});
- Value when is_record(Value,valuedef);
- is_record(Value,typedef); %Value set may be parsed as object set.
- is_record(Value,pvaluedef);
- is_record(Value,pvaluesetdef) ->
- NewS = S#state{value=Value},
- case catch(check_value(NewS,Value)) of
- {error,Reason} ->
- error({value,Reason,NewS});
- {'EXIT',Reason} ->
- error({value,{internal_error,Reason},NewS});
- {pobjectsetdef} ->
- {pobjectsetdef,Name};
- {objectsetdef} ->
- {objectsetdef,Name};
- {objectdef} ->
- %% this is an object, save as typedef
- #valuedef{checked=C,pos=Pos,name=N,type=Type,
- value=Def}=Value,
- ClassName = Type#type.def,
- NewSpec = #'Object'{classname=ClassName,
- def=Def},
- NewDef = #typedef{checked=C,pos=Pos,name=N,
- typespec=NewSpec},
- asn1_db:dbput(NewS#state.mname,Name,NewDef),
- {objectdef,Name};
- {valueset,VSet} ->
- Pos = asn1ct:get_pos_of_def(Value),
- CheckedVSDef = #typedef{checked=true,pos=Pos,
- name=Name,typespec=VSet},
- asn1_db:dbput(NewS#state.mname,Name,CheckedVSDef),
- {valueset,Name};
- V ->
- %% update the valuedef
- asn1_db:dbput(NewS#state.mname,Name,V),
- ok
- end
- end,
- case Result of
- ok ->
- checkv(S,T,Acc);
- _ ->
- checkv(S,T,[Result|Acc])
- end;
-checkv(_S,[],Acc) ->
- lists:reverse(Acc).
-
-
-checkp(S,[Name|T],Acc) ->
- %io:format("check_ptypedef:~p~n",[Name]),
- Result = case asn1_db:dbget(S#state.mname,Name) of
- undefined ->
- error({type,{internal_error,'???'},S});
- Type when is_record(Type,ptypedef) ->
- NewS = S#state{type=Type,tname=Name},
- case catch(check_ptype(NewS,Type,Type#ptypedef.typespec)) of
- {error,Reason} ->
- error({type,Reason,NewS});
- {'EXIT',Reason} ->
- error({type,{internal_error,Reason},NewS});
- {asn1_class,_ClassDef} ->
- {asn1_class,Name};
- {asn1_param_class,_} -> ok;
- Ts ->
- NewType = Type#ptypedef{checked=true,typespec = Ts},
- asn1_db:dbput(NewS#state.mname,Name,NewType), % update the type
- ok
- end
- end,
- case Result of
- ok ->
- checkp(S,T,Acc);
- _ ->
- checkp(S,T,[Result|Acc])
- end;
-checkp(_S,[],Acc) ->
- lists:reverse(Acc).
-
+checkv(S, Names) ->
+ check_fold(S, Names, fun do_checkv/3).
+
+do_checkv(S, Name, Value)
+ when is_record(Value, valuedef);
+ is_record(Value, typedef); %Value set may be parsed as object set.
+ is_record(Value, pvaluedef);
+ is_record(Value, pvaluesetdef) ->
+ NewS = S#state{value=Value},
+ try check_value(NewS, Value) of
+ {valueset,VSet} ->
+ Pos = asn1ct:get_pos_of_def(Value),
+ CheckedVSDef = #typedef{checked=true,pos=Pos,
+ name=Name,typespec=VSet},
+ asn1_db:dbput(NewS#state.mname, Name, CheckedVSDef),
+ {valueset,Name};
+ V ->
+ %% update the valuedef
+ asn1_db:dbput(NewS#state.mname, Name, V),
+ ok
+ catch
+ {error,Reason} ->
+ error({value,Reason,NewS});
+ {pobjectsetdef} ->
+ {pobjectsetdef,Name};
+ {objectsetdef} ->
+ {objectsetdef,Name};
+ {objectdef} ->
+ %% this is an object, save as typedef
+ #valuedef{checked=C,pos=Pos,name=N,type=Type,
+ value=Def} = Value,
+ ClassName = Type#type.def,
+ NewSpec = #'Object'{classname=ClassName,def=Def},
+ NewDef = #typedef{checked=C,pos=Pos,name=N,typespec=NewSpec},
+ asn1_db:dbput(NewS#state.mname, Name, NewDef),
+ {objectdef,Name}
+ end.
+%% Check parameterized types.
+checkp(S, Names) ->
+ check_fold(S, Names, fun do_checkp/3).
+do_checkp(S0, Name, #ptypedef{typespec=TypeSpec}=Type0) ->
+ S = S0#state{type=Type0,tname=Name},
+ try check_ptype(S, Type0, TypeSpec) of
+ #type{}=Ts ->
+ Type = Type0#ptypedef{checked=true,typespec=Ts},
+ asn1_db:dbput(S#state.mname, Name, Type),
+ ok
+ catch
+ {error,Reason} ->
+ error({type,Reason,S});
+ {asn1_class,_ClassDef} ->
+ {asn1_class,Name};
+ {asn1_param_class,_} ->
+ ok
+ end.
-checkc(S,[Name|Cs],Acc) ->
- Result =
- case asn1_db:dbget(S#state.mname,Name) of
- undefined ->
- error({class,{internal_error,'???'},S});
- Class ->
- ClassSpec = if
- is_record(Class,classdef) ->
-% Class#classdef.typespec;
- Class;
- is_record(Class,typedef) ->
- Class#typedef.typespec
- end,
- NewS = S#state{type=Class,tname=Name},
- case catch(check_class(NewS,ClassSpec)) of
- {error,Reason} ->
- error({class,Reason,NewS});
- {'EXIT',Reason} ->
- error({class,{internal_error,Reason},NewS});
- C ->
- %% update the classdef
- NewClass =
- if
- is_record(Class,classdef) ->
- Class#classdef{checked=true,typespec=C};
- is_record(Class,typedef) ->
- #classdef{checked=true,name=Name,typespec=C}
- end,
- asn1_db:dbput(NewS#state.mname,Name,NewClass),
- ok
- end
+%% Check class definitions.
+checkc(S, Names) ->
+ check_fold(S, Names, fun do_checkc/3).
+
+do_checkc(S0, Name, Class0) ->
+ {Class1,ClassSpec} =
+ case Class0 of
+ #classdef{} ->
+ {Class0,Class0};
+ #typedef{} ->
+ {#classdef{name=Name},Class0#typedef.typespec}
end,
- case Result of
- ok ->
- checkc(S,Cs,Acc);
- _ ->
- checkc(S,Cs,[Result|Acc])
- end;
-checkc(_S,[],Acc) ->
-%% include_default_class(S#state.mname),
- lists:reverse(Acc).
+ S = S0#state{type=Class0,tname=Name},
+ try check_class(S, ClassSpec) of
+ C ->
+ Class = Class1#classdef{checked=true,typespec=C},
+ asn1_db:dbput(S#state.mname, Name, Class),
+ ok
+ catch
+ {error,Reason} ->
+ error({class,Reason,S})
+ end.
checko(S,[Name|Os],Acc,ExclO,ExclOS) ->
?dbg("Checking object ~p~n",[Name]),
@@ -695,8 +639,7 @@ check_class_fields(S,[F|Fields],Acc) ->
Type2 = maybe_unchecked_OCFT(S,Type),
Cat =
case asn1ct_gen:type(asn1ct_gen:get_inner(Type2#type.def)) of
- Def when is_record(Def,typereference);
- is_record(Def,'Externaltypereference') ->
+ Def when is_record(Def,'Externaltypereference') ->
{_,D} = get_referenced_type(S,Def),
D;
{undefined,user} ->
@@ -876,14 +819,6 @@ check_object(S,
?dbg("check_object set: ~p~n",[ObjSet#'ObjectSet'.set]),
{_,ClassDef} = get_referenced_type(S,ClassRef),
NewClassRef = check_externaltypereference(S,ClassRef),
- %% XXXXXXXXXX
- case ObjSet of
- #'ObjectSet'{set={'Externaltypereference',undefined,'MSAccessProtocol',
- 'AllOperations'}} ->
- ok;
- _ ->
- ok
- end,
{UniqueFieldName,UniqueInfo} =
case (catch get_unique_fieldname(S,ClassDef)) of
{error,'__undefined_',_} ->
@@ -1233,8 +1168,7 @@ check_object_list(S,ClassRef,[ObjOrSet|Objs],Acc) ->
ObjSet when is_record(ObjSet,type) ->
ObjSetDef =
case ObjSet#type.def of
- Ref when is_record(Ref,typereference);
- is_record(Ref,'Externaltypereference') ->
+ Ref when is_record(Ref,'Externaltypereference') ->
{_,D} = get_referenced_type(S,ObjSet#type.def),
D;
Other ->
@@ -1826,10 +1760,6 @@ convert_to_defaultfield(S,ObjFieldName,[OFS|RestOFS],CField)->
T = check_type(S,#typedef{typespec=ObjFieldSetting},
ObjFieldSetting),
{#typedef{checked=true,name=Bif,typespec=T},RestSettings};
- _OCFT = #'ObjectClassFieldType'{} ->
- T=check_type(S,#typedef{typespec=ObjFieldSetting},ObjFieldSetting),
- %%io:format("OCFT=~p~n,T=~p~n",[OCFT,T]),
- {#typedef{checked=true,typespec=T},RestSettings};
_ ->
%this case should not happen any more
{Mod,T} =
@@ -2140,172 +2070,72 @@ check_value(S,#valuedef{pos=Pos,name=Name,type=Type,
NewType = Type#type{constraint=[Constr]},
{valueset,
check_type(S,#typedef{pos=Pos,name=Name,typespec=NewType},NewType)};
-check_value(OldS=#state{recordtopname=TopName},V) when is_record(V,valuedef) ->
- #valuedef{name=Name,checked=Checked,type=Vtype,
- value=Value,module=ModName} = V,
- ?dbg("check_value, V: ~p~n",[V]),
- case Checked of
- true ->
- V;
- {error,_} ->
+check_value(S, #valuedef{}=V) ->
+ ?dbg("check_value, V: ~p~n",[V0]),
+ case V of
+ #valuedef{checked=true} ->
V;
- false ->
- Def = Vtype#type.def,
- Constr = Vtype#type.constraint,
- S = OldS#state{type=Vtype,tname=Def,value=V,vname=Name},
- SVal = update_state(S,ModName),
- NewDef =
- case Def of
- Ext when is_record(Ext,'Externaltypereference') ->
- RecName = Ext#'Externaltypereference'.type,
- {RefM,Type} = get_referenced_type(S,Ext),
- %% If V isn't a value but an object Type is a #classdef{}
- %%NewS = S#state{mname=RefM},
- NewS = update_state(S,RefM),
- case Type of
- #classdef{} ->
- throw({objectdef});
- #typedef{} ->
- case is_contextswitchtype(Type) of
- true ->
- #valuedef{value=CheckedVal}=
- check_value(NewS,V#valuedef{type=Type#typedef.typespec}),
- #newv{value=CheckedVal};
- _ ->
- #valuedef{value=CheckedVal}=
- check_value(NewS#state{recordtopname=[RecName|TopName]},
- V#valuedef{type=Type#typedef.typespec}),
- #newv{value=CheckedVal}
- end;
- #type{} ->
- %% A parameter that couldn't be categorized.
- #valuedef{value=CheckedVal}=
- check_value(NewS#state{recordtopname=[RecName|TopName]},
- V#valuedef{type=Type}),
- #newv{value=CheckedVal}
- end;
- 'ANY' ->
- case Value of
- {opentypefieldvalue,ANYType,ANYValue} ->
- CheckedV=
- check_value(SVal,#valuedef{name=Name,
- type=ANYType,
- value=ANYValue,
- module=ModName}),
- #newv{value=CheckedV#valuedef.value};
- _ ->
- throw({error,{asn1,{'cant check value of type',Def}}})
- end;
- 'INTEGER' ->
- ok=validate_integer(SVal,Value,[],Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- {'INTEGER',NamedNumberList} ->
- ok=validate_integer(SVal,Value,NamedNumberList,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- {'BIT STRING',NamedNumberList} ->
- ok=validate_bitstring(SVal,Value,NamedNumberList,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'NULL' ->
- ok=validate_null(SVal,Value,Constr),
- #newv{};
- 'OBJECT IDENTIFIER' ->
- {ok,_}=validate_objectidentifier(SVal,Value,Constr),
- #newv{value = normalize_value(SVal,Vtype,Value,[])};
- 'RELATIVE-OID' ->
- {ok,_}=validate_relative_oid(SVal,Value,Constr),
- #newv{value = Value};
- 'ObjectDescriptor' ->
- ok=validate_objectdescriptor(SVal,Value,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'REAL' ->
- ok = validate_real(SVal,Value,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- {'ENUMERATED',NamedNumberList} ->
- ok=validate_enumerated(SVal,Value,NamedNumberList,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'BOOLEAN'->
- ok=validate_boolean(SVal,Value,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'OCTET STRING' ->
- ok=validate_octetstring(SVal,Value,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'NumericString' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- TString when TString =:= 'TeletexString';
- TString =:= 'T61String' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'VideotexString' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'UTCTime' ->
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
-% exit({'cant check value of type' ,Def});
- 'GeneralizedTime' ->
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
-% exit({'cant check value of type' ,Def});
- 'GraphicString' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'VisibleString' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'GeneralString' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'PrintableString' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'IA5String' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'BMPString' ->
- ok=validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'UTF8String' ->
- ok = validate_restrictedstring(SVal,Vtype,Value,Constr),
- %%io:format("Vtype: ~p~nValue: ~p~n",[Vtype,Value]);
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- 'UniversalString' -> %added 6/12 -00
- ok = validate_restrictedstring(SVal,Value,Def,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,[])};
- Seq when is_record(Seq,'SEQUENCE') ->
- {ok,SeqVal} = validate_sequence(SVal,Value,
- Seq#'SEQUENCE'.components,
- Constr),
- #newv{value=normalize_value(SVal,Vtype,SeqVal,TopName)};
- {'SEQUENCE OF',Components} ->
- ok=validate_sequenceof(SVal,Value,Components,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,TopName)};
- {'CHOICE',Components} ->
- ok=validate_choice(SVal,Value,Components,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,TopName)};
- Set when is_record(Set,'SET') ->
- ok=validate_set(SVal,Value,Set#'SET'.components,
- Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,TopName)};
- {'SET OF',Components} ->
- ok=validate_setof(SVal,Value,Components,Constr),
- #newv{value=normalize_value(SVal,Vtype,Value,TopName)};
- {'SelectionType',SelName,SelT} ->
- CheckedT = check_selectiontype(SVal,SelName,SelT),
- NewV = V#valuedef{type=CheckedT},
- SelVDef=check_value(S#state{value=NewV},NewV),
- #newv{value=SelVDef#valuedef.value};
- Other ->
- exit({'cannot check value of type' ,Other})
- end,
- case NewDef#newv.value of
- unchanged ->
- V#valuedef{checked=true,value=Value};
- ok ->
- V#valuedef{checked=true,value=Value};
- {error,Reason} ->
- V#valuedef{checked={error,Reason},value=Value};
- _V ->
- V#valuedef{checked=true,value=_V}
- end
+ #valuedef{checked=false} ->
+ check_valuedef(S, V)
+ end.
+
+check_valuedef(#state{recordtopname=TopName}=S0, V0) ->
+ #valuedef{name=Name,type=Vtype,value=Value,module=ModName} = V0,
+ V = V0#valuedef{checked=true},
+ Def = Vtype#type.def,
+ Constr = Vtype#type.constraint,
+ S1 = S0#state{type=Vtype,tname=Def,value=V0,vname=Name},
+ SVal = update_state(S1, ModName),
+ case Def of
+ #'Externaltypereference'{type=RecName}=Ext ->
+ {RefM,Type} = get_referenced_type(S1, Ext),
+ %% If V isn't a value but an object Type is a #classdef{}
+ S2 = update_state(S1, RefM),
+ case Type of
+ #classdef{} ->
+ throw({objectdef});
+ #typedef{typespec=TypeSpec} ->
+ S3 = case is_contextswitchtype(Type) of
+ true ->
+ S2;
+ false ->
+ S2#state{recordtopname=[RecName|TopName]}
+ end,
+ #valuedef{value=CheckedVal} =
+ check_value(S3, V0#valuedef{type=TypeSpec}),
+ V#valuedef{value=CheckedVal};
+ #type{} ->
+ %% A parameter that couldn't be categorized.
+ #valuedef{value=CheckedVal} =
+ check_value(S2#state{recordtopname=[RecName|TopName]},
+ V#valuedef{type=Type}),
+ V#valuedef{value=CheckedVal}
+ end;
+ 'ANY' ->
+ {opentypefieldvalue,ANYType,ANYValue} = Value,
+ CheckedV = check_value(SVal,#valuedef{name=Name,
+ type=ANYType,
+ value=ANYValue,
+ module=ModName}),
+ V#valuedef{value=CheckedV#valuedef.value};
+ 'INTEGER' ->
+ ok = validate_integer(SVal, Value, [], Constr),
+ V#valuedef{value=normalize_value(SVal, Vtype, Value, [])};
+ {'INTEGER',NamedNumberList} ->
+ ok = validate_integer(SVal, Value, NamedNumberList, Constr),
+ V#valuedef{value=normalize_value(SVal, Vtype, Value, [])};
+ #'SEQUENCE'{components=Components} ->
+ {ok,SeqVal} = validate_sequence(SVal, Value,
+ Components, Constr),
+ V#valuedef{value=normalize_value(SVal, Vtype,
+ SeqVal, TopName)};
+ {'SelectionType',SelName,SelT} ->
+ CheckedT = check_selectiontype(SVal, SelName, SelT),
+ NewV = V#valuedef{type=CheckedT},
+ SelVDef = check_value(S1#state{value=NewV}, NewV),
+ V#valuedef{value=SelVDef#valuedef.value};
+ _ ->
+ V#valuedef{value=normalize_value(SVal, Vtype, Value, TopName)}
end.
is_contextswitchtype(#typedef{name='EXTERNAL'})->
@@ -2358,23 +2188,7 @@ validate_integer_ref(S,Ref,NamedNumberList,Constr) ->
-check_integer_range(Int,Constr) when is_list(Constr) ->
- NewConstr = [X || #constraint{c=X} <- Constr],
- check_constr(Int,NewConstr);
-
-check_integer_range(_Int,_Constr) ->
- %%io:format("~p~n",[Constr]),
- ok.
-
-check_constr(Int,[{'ValueRange',Lb,Ub}|T]) when Int >= Lb, Int =< Ub ->
- check_constr(Int,T);
-check_constr(_Int,[]) ->
- ok.
-
-validate_bitstring(_S,_Value,_NamedNumberList,_Constr) ->
- ok.
-
-validate_null(_S,'NULL',_Constr) ->
+check_integer_range(_Int, Constr) when is_list(Constr) ->
ok.
%%------------
@@ -2390,9 +2204,6 @@ is_space_list([],Acc) ->
is_space_list([H|T],Acc) ->
is_space_list(T,[H|Acc]).
-validate_objectidentifier(S,ERef,C) ->
- validate_objectidentifier(S,o_id,ERef,C).
-
validate_objectidentifier(S,OID,ERef,C)
when is_record(ERef,'Externalvaluereference') ->
validate_objectidentifier(S,OID,[ERef],C);
@@ -2490,9 +2301,6 @@ validate_oid(_, S, OID, [Atom|Rest],Acc) when is_atom(Atom) ->
validate_oid(_, S, OID, V, Acc) ->
error({value, {"illegal "++to_string(OID),V,Acc},S}).
-validate_relative_oid(S,Value,Constr) ->
- validate_objectidentifier(S,rel_oid,Value,Constr).
-
is_object_id(OID,S,ERef=#'Externaltypereference'{}) ->
{_,OI} = get_referenced_type(S,ERef),
is_object_id(OID,S,OI#typedef.typespec);
@@ -2579,43 +2387,6 @@ valid_objectid(o_id,_I,[1]) -> false;
valid_objectid(o_id,_I,[2]) -> true;
valid_objectid(_,_,_) -> true.
-
-
-
-
-
-validate_objectdescriptor(_S,_Value,_Constr) ->
- ok.
-
-validate_real(_S,_Value,_Constr) ->
- ok.
-
-validate_enumerated(S,Id,NamedNumberList,_Constr) when is_atom(Id) ->
- case lists:keysearch(Id,1,NamedNumberList) of
- {value,_} -> ok;
- false -> error({value,"unknown ENUMERATED",S})
- end;
-validate_enumerated(S,{identifier,_Pos,Id},NamedNumberList,_Constr) ->
- case lists:keysearch(Id,1,NamedNumberList) of
- {value,_} -> ok;
- false -> error({value,"unknown ENUMERATED",S})
- end;
-validate_enumerated(S,#'Externalvaluereference'{value=Id},
- NamedNumberList,_Constr) ->
- case lists:keysearch(Id,1,NamedNumberList) of
- {value,_} -> ok;
- false -> error({value,"unknown ENUMERATED",S})
- end.
-
-validate_boolean(_S,_Value,_Constr) ->
- ok.
-
-validate_octetstring(_S,_Value,_Constr) ->
- ok.
-
-validate_restrictedstring(_S,_Value,_Def,_Constr) ->
- ok.
-
validate_sequence(S=#state{type=Vtype},Value,_Components,_Constr) ->
case Vtype of
#type{tag=[{tag,'UNIVERSAL',8,'IMPLICIT',32}]} ->
@@ -2630,18 +2401,6 @@ validate_sequence(S=#state{type=Vtype},Value,_Components,_Constr) ->
{ok,Value}
end.
-validate_sequenceof(_S,_Value,_Components,_Constr) ->
- ok.
-
-validate_choice(_S,_Value,_Components,_Constr) ->
- ok.
-
-validate_set(_S,_Value,_Components,_Constr) ->
- ok.
-
-validate_setof(_S,_Value,_Components,_Constr) ->
- ok.
-
to_EXTERNAL1990(S,[{identification,{'CHOICE',{syntax,Stx}}}|Rest]) ->
to_EXTERNAL1990(S,Rest,[{'direct-reference',Stx}]);
to_EXTERNAL1990(S,[{identification,{'CHOICE',{'presentation-context-id',I}}}|Rest]) ->
@@ -2667,7 +2426,8 @@ normalize_value(_,_,mandatory,_) ->
mandatory;
normalize_value(_,_,'OPTIONAL',_) ->
'OPTIONAL';
-normalize_value(S,Type,{'DEFAULT',Value},NameList) ->
+normalize_value(S0, Type, {'DEFAULT',Value}, NameList) ->
+ S = S0#state{value=Value},
case catch get_canonic_type(S,Type,NameList) of
{'BOOLEAN',CType,_} ->
normalize_boolean(S,Value,CType);
@@ -2892,12 +2652,12 @@ hstring_to_octetlist([H|T],BSL,Acc) when H >= $0; H =< $9 ->
hstring_to_octetlist([],_,Acc) ->
lists:reverse(Acc).
-normalize_objectidentifier(S,Value) ->
- {ok,Val}=validate_objectidentifier(S,Value,[]),
+normalize_objectidentifier(S, Value) ->
+ {ok,Val} = validate_objectidentifier(S, o_id, Value, []),
Val.
normalize_relative_oid(S,Value) ->
- {ok,Val} = validate_relative_oid(S,Value,[]),
+ {ok,Val} = validate_objectidentifier(S, rel_oid, Value, []),
Val.
normalize_objectdescriptor(Value) ->
@@ -2906,29 +2666,20 @@ normalize_objectdescriptor(Value) ->
normalize_real(Value) ->
Value.
-normalize_enumerated(S,#'Externalvaluereference'{value=V},CType)
- when is_list(CType) ->
- normalize_enumerated2(S,V,CType);
-normalize_enumerated(S,Value,CType) when is_atom(Value),is_list(CType) ->
- normalize_enumerated2(S,Value,CType);
-normalize_enumerated(S,{Name,EnumV},CType) when is_atom(Name) ->
- normalize_enumerated(S,EnumV,CType);
-normalize_enumerated(S,Value,{CType1,CType2}) when is_list(CType1), is_list(CType2)->
- normalize_enumerated(S,Value,CType1++CType2);
-normalize_enumerated(S,V,CType) ->
- asn1ct:warning("Enumerated unknown type ~p~n",[CType],S,
- "Enumerated unknown type"),
- V.
-normalize_enumerated2(S,V,Enum) ->
- case lists:keysearch(V,1,Enum) of
- {value,{Val,_}} -> Val;
- _ ->
- asn1ct:warning("enumerated value is not correct ~p~n",[V],S,
- "enumerated value is not correct"),
- V
+normalize_enumerated(S, Id, {Base,Ext}) ->
+ %% Extensible ENUMERATED.
+ normalize_enumerated(S, Id, Base++Ext);
+normalize_enumerated(S, #'Externalvaluereference'{value=Id},
+ NamedNumberList) ->
+ normalize_enumerated(S, Id, NamedNumberList);
+normalize_enumerated(S, Id, NamedNumberList) when is_atom(Id) ->
+ case lists:keymember(Id, 1, NamedNumberList) of
+ true ->
+ Id;
+ false ->
+ throw(asn1_error(S, S#state.value, {undefined,Id}))
end.
-
normalize_choice(S,{'CHOICE',{C,V}},CType,NameList) when is_atom(C) ->
case catch lists:keysearch(C,#'ComponentType'.name,CType) of
{value,#'ComponentType'{typespec=CT,name=Name}} ->
@@ -3535,10 +3286,6 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
merge_tags(Tag,?TAG_CONSTRUCTED(?N_SET))};
%% This is a temporary hack until the full Information Obj Spec
%% in X.681 is supported
- {{typereference,_,'TYPE-IDENTIFIER'},[{typefieldreference,_,'Type'}]} ->
- Ct=maybe_illicit_implicit_tag(open_type,Tag),
- TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct};
-
{#'Externaltypereference'{type='TYPE-IDENTIFIER'},
[{typefieldreference,_,'Type'}]} ->
Ct=maybe_illicit_implicit_tag(open_type,Tag),
@@ -3575,7 +3322,15 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
_ ->
MergedTag
end,
- TempNewDef#newt{type=NewTypeDef,tag=Ct};
+ case TopName of
+ [] when Type#typedef.name =/= undefined ->
+ %% This is a top-level type.
+ #type{def=Simplified} =
+ simplify_type(#type{def=NewTypeDef}),
+ TempNewDef#newt{type=Simplified,tag=Ct};
+ _ ->
+ TempNewDef#newt{type=NewTypeDef,tag=Ct}
+ end;
{'TypeFromObject',{object,Object},TypeField} ->
CheckedT = get_type_from_object(S,Object,TypeField),
@@ -3591,29 +3346,14 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
Other ->
exit({'cant check' ,Other})
end,
- Ts2 = case NewDef of
- #newt{type=unchanged} ->
- Ts#type{def=Def};
- #newt{type=TDef}->
- Ts#type{def=TDef}
- end,
- NewTag = case NewDef of
- #newt{tag=unchanged} ->
- Tag;
- #newt{tag=TT} ->
- TT
- end,
- T3 = Ts2#type{tag = lists:map(fun(TempTag = #tag{type={default,TTx}}) ->
- TempTag#tag{type=TTx};
- (Else) -> Else end, NewTag)},
- T4 = case NewDef of
- #newt{constraint=unchanged} ->
- T3#type{constraint=Constr};
- #newt{constraint=NewConstr} ->
- T3#type{constraint=NewConstr}
- end,
- T5 = T4#type{inlined=NewDef#newt.inlined},
- T5#type{constraint=check_constraints(S,T5#type.constraint)};
+ #newt{type=TDef,tag=NewTags,constraint=NewConstr,inlined=Inlined} = NewDef,
+ Ts#type{def=TDef,
+ inlined=Inlined,
+ constraint=check_constraints(S, NewConstr),
+ tag=lists:map(fun(#tag{type={default,TTx}}=TempTag) ->
+ TempTag#tag{type=TTx};
+ (Other) -> Other
+ end, NewTags)};
check_type(_S,Type,Ts) ->
exit({error,{asn1,internal_error,Type,Ts}}).
@@ -3625,6 +3365,28 @@ get_non_typedef(S, Tref0) ->
Type
end.
+
+%%
+%% Simplify the backends by getting rid of an #'ObjectClassFieldType'{}
+%% with a type known at compile time.
+%%
+
+simplify_comps(Comps) ->
+ [simplify_comp(Comp) || Comp <- Comps].
+
+simplify_comp(#'ComponentType'{typespec=Type0}=C) ->
+ Type = simplify_type(Type0),
+ C#'ComponentType'{typespec=Type};
+simplify_comp(Other) -> Other.
+
+simplify_type(#type{tag=Tag,def=Inner}=T) ->
+ case Inner of
+ #'ObjectClassFieldType'{type={fixedtypevaluefield,_,Type}} ->
+ Type#type{tag=Tag};
+ _ ->
+ T
+ end.
+
%% tablecinf_choose. A SEQUENCE or SET may be inserted in another
%% SEQUENCE or SET by the COMPONENTS OF directive. If this inserted
%% type is a referenced type that already has been checked it already
@@ -4003,26 +3765,10 @@ categorize(_S,type,Def) when is_record(Def,type) ->
categorize(_,_,Def) ->
[Def].
categorize(S,object_set,Def,ClassRef) ->
- %% XXXXXXXXXX
- case Def of
- {'Externaltypereference',undefined,'MSAccessProtocol','AllOperations'} ->
- ok;
- _ ->
- ok
- end,
NewObjSetSpec =
check_object(S,Def,#'ObjectSet'{class = ClassRef,
set = parse_objectset(Def)}),
Name = new_reference_name("object_set_argument"),
- %% XXXXXXXXXX
- case Name of
- internal_object_set_argument_78 ->
- ok;
- internal_object_set_argument_77 ->
- ok;
- _ ->
- ok
- end,
[save_object_set_instance(S,Name,NewObjSetSpec)];
categorize(_S,object,Def,_ClassRef) ->
%% should be handled
@@ -4048,9 +3794,7 @@ parse_objectset(Set) ->
%% check_constraints/2
%%
check_constraints(S,C) when is_list(C) ->
- check_constraints(S, C, []);
-check_constraints(S,C) when is_record(C,constraint) ->
- check_constraints(S, C#constraint.c, []).
+ check_constraints(S, C, []).
resolv_tuple_or_list(S,List) when is_list(List) ->
lists:map(fun(X)->resolv_value(S,X) end, List);
@@ -4077,23 +3821,19 @@ resolv_value1(S, ERef = #'Externalvaluereference'{value=Name}) ->
resolv_value1(S,VDef)
end
end;
-resolv_value1(S,{gt,V}) ->
- case V of
+resolv_value1(S, {gt,V}) ->
+ case resolv_value1(S, V) of
Int when is_integer(Int) ->
- V + 1;
- #valuedef{value=Int} ->
- 1 + resolv_value(S,Int);
+ Int + 1;
Other ->
- throw({error,{asn1,{undefined_type_or_value,Other}}})
+ throw({error,{asn1,{not_integer_value,Other}}})
end;
-resolv_value1(S,{lt,V}) ->
- case V of
+resolv_value1(S, {lt,V}) ->
+ case resolv_value1(S, V) of
Int when is_integer(Int) ->
- V - 1;
- #valuedef{value=Int} ->
- resolv_value(S,Int) - 1;
+ Int - 1;
Other ->
- throw({error,{asn1,{undefined_type_or_value,Other}}})
+ throw({error,{asn1,{not_integer_value,Other}}})
end;
resolv_value1(S,{'ValueFromObject',{object,Object},[{valuefieldreference,
FieldName}]}) ->
@@ -4356,7 +4096,42 @@ normalize_cs([{'ValueRange',{Sv,Sv}}|Cs]) ->
[{'SingleValue',Sv}|normalize_cs(Cs)];
normalize_cs([{'ValueRange',{'MIN','MAX'}}|Cs]) ->
normalize_cs(Cs);
-normalize_cs(Other) -> Other.
+normalize_cs([{'SizeConstraint',C0}|Cs]) ->
+ case normalize_size_constraint(C0) of
+ none ->
+ normalize_cs(Cs);
+ C ->
+ [{'SizeConstraint',C}|normalize_cs(Cs)]
+ end;
+normalize_cs([H|T]) ->
+ [H|normalize_cs(T)];
+normalize_cs([]) -> [].
+
+%% Normalize a size constraint to make it non-ambiguous and
+%% easy to interpret for the backends.
+%%
+%% Returns one of the following terms:
+%% {LowerBound,UpperBound}
+%% {{LowerBound,UpperBound},[]} % Extensible
+%% none % Remove size constraint from list
+%%
+%% where:
+%% LowerBound = integer()
+%% UpperBound = integer() | 'MAX'
+
+normalize_size_constraint(Sv) when is_integer(Sv) ->
+ {Sv,Sv};
+normalize_size_constraint({Root,Ext}) when is_list(Ext) ->
+ {normalize_size_constraint(Root),[]};
+normalize_size_constraint({{_,_},Ext}) when is_integer(Ext) ->
+ normalize_size_constraint(Ext);
+normalize_size_constraint([H|T]) ->
+ {H,lists:last(T)};
+normalize_size_constraint({0,'MAX'}) ->
+ none;
+normalize_size_constraint({Lb,Ub}=Range)
+ when is_integer(Lb), is_integer(Ub) orelse Ub =:= 'MAX' ->
+ Range.
is_range(Prev, [H|T]) when Prev =:= H - 1 -> is_range(H, T);
is_range(_, [_|_]) -> false;
@@ -4925,19 +4700,7 @@ get_referenced(S,Emod,Ename,Pos) ->
end;
T when is_record(T,typedef) ->
?dbg("get_referenced T: ~p~n",[T]),
- Spec = T#typedef.typespec, %% XXXX Spec may be something else than #type
- case Spec of
- #type{def=#typereference{}} ->
- Tref = Spec#type.def,
- Def = #'Externaltypereference'{module=Emod,
- type=Tref#typereference.val,
- pos=Tref#typereference.pos},
-
-
- {Emod,T#typedef{typespec=Spec#type{def=Def}}};
- _ ->
- {Emod,T} % should add check that T is exported here
- end;
+ {Emod,T}; % should add check that T is exported here
V ->
?dbg("get_referenced V: ~p~n",[V]),
{Emod,V}
@@ -5385,14 +5148,14 @@ iof_associated_type1(S,C) ->
prop=mandatory,
tags=[{'CONTEXT',0}]}],
#'SEQUENCE'{tablecinf=TableCInf,
- components=IOFComponents}.
+ components=simplify_comps(IOFComponents)}.
%% returns the leading attribute, the constraint of the components and
%% the tablecinf value for the second component.
instance_of_constraints(_,[]) ->
{false,[],[],[]};
-instance_of_constraints(S,#constraint{c={simpletable,Type}}) ->
+instance_of_constraints(S, [{simpletable,Type}]) ->
#type{def=#'Externaltypereference'{type=Name}} = Type,
ModuleName = S#state.mname,
ObjectSetRef=#'Externaltypereference'{module=ModuleName,
@@ -5403,7 +5166,8 @@ instance_of_constraints(S,#constraint{c={simpletable,Type}}) ->
[{innermost,
[#'Externalvaluereference'{module=ModuleName,
value=type}]}]}],
- TableCInf=#simpletableattributes{objectsetname=Name,
+ Mod = S#state.mname,
+ TableCInf=#simpletableattributes{objectsetname={Mod,Name},
c_name='type-id',
c_index=1,
usedclassfield=id,
@@ -5539,46 +5303,37 @@ check_sequence(S,Type,Comps) ->
%% the involved class removed, as the class of the object
%% set.
CompListWithTblInf = get_tableconstraint_info(S,Type,NewComps2),
- %% If encoding rule is in the PER family the Root Components
- %% after the second extension mark should be encoded before
- %% all extensions i.e together with the first Root components
NewComps3 = textual_order(CompListWithTblInf),
- CompListTuple =
- complist_as_tuple(is_erule_per(S#state.erule),NewComps3),
+ NewComps4 = simplify_comps(NewComps3),
+ CompListTuple = complist_as_tuple(NewComps4),
{CRelInf,CompListTuple};
Dupl ->
throw({error,{asn1,{duplicate_components,Dupl}}})
end.
-complist_as_tuple(Per,CompList) ->
- complist_as_tuple(Per,CompList,[],[],[],root).
+complist_as_tuple(CompList) ->
+ complist_as_tuple(CompList, [], [], [], root).
-complist_as_tuple(Per,[#'EXTENSIONMARK'{}|T],Acc,Ext,Acc2,root) ->
- complist_as_tuple(Per,T,Acc,Ext,Acc2,ext);
-complist_as_tuple(Per,[#'EXTENSIONMARK'{}|T],Acc,Ext,Acc2,ext) ->
- complist_as_tuple(Per,T,Acc,Ext,Acc2,root2);
-complist_as_tuple(_Per,[#'EXTENSIONMARK'{}|_T],_Acc,_Ext,_Acc2,root2) ->
+complist_as_tuple([#'EXTENSIONMARK'{}|T], Acc, Ext, Acc2, root) ->
+ complist_as_tuple(T, Acc, Ext, Acc2, ext);
+complist_as_tuple([#'EXTENSIONMARK'{}|T], Acc, Ext, Acc2, ext) ->
+ complist_as_tuple(T, Acc, Ext, Acc2, root2);
+complist_as_tuple([#'EXTENSIONMARK'{}|_T], _Acc, _Ext, _Acc2, root2) ->
throw({error,{asn1,{too_many_extension_marks}}});
-complist_as_tuple(Per,[C|T],Acc,Ext,Acc2,root) ->
- complist_as_tuple(Per,T,[C|Acc],Ext,Acc2,root);
-complist_as_tuple(Per,[C|T],Acc,Ext,Acc2,ext) ->
- complist_as_tuple(Per,T,Acc,[C|Ext],Acc2,ext);
-complist_as_tuple(Per,[C|T],Acc,Ext,Acc2,root2) ->
- complist_as_tuple(Per,T,Acc,Ext,[C|Acc2],root2);
-complist_as_tuple(_Per,[],Acc,_Ext,_Acc2,root) ->
+complist_as_tuple([C|T], Acc, Ext, Acc2, root) ->
+ complist_as_tuple(T, [C|Acc], Ext, Acc2, root);
+complist_as_tuple([C|T], Acc, Ext, Acc2, ext) ->
+ complist_as_tuple(T, Acc, [C|Ext], Acc2, ext);
+complist_as_tuple([C|T], Acc, Ext, Acc2, root2) ->
+ complist_as_tuple(T, Acc, Ext, [C|Acc2], root2);
+complist_as_tuple([], Acc, _Ext, _Acc2, root) ->
lists:reverse(Acc);
-complist_as_tuple(_Per,[],Acc,Ext,_Acc2,ext) ->
+complist_as_tuple([], Acc, Ext, _Acc2, ext) ->
{lists:reverse(Acc),lists:reverse(Ext)};
-%%complist_as_tuple(_Per = true,[],Acc,Ext,Acc2,root2) ->
-%% {lists:reverse(Acc)++lists:reverse(Acc2),lists:reverse(Ext)};
-complist_as_tuple(_Per,[],Acc,Ext,Acc2,root2) ->
+complist_as_tuple([], Acc, Ext, Acc2, root2) ->
{lists:reverse(Acc),lists:reverse(Ext),lists:reverse(Acc2)}.
-is_erule_per(per) -> true;
-is_erule_per(uper) -> true;
-is_erule_per(ber) -> false.
-
expand_components(S, [{'COMPONENTS OF',Type}|T]) ->
CompList = expand_components2(S,get_referenced_type(S,Type#type.def)),
expand_components(S,CompList) ++ expand_components(S,T);
@@ -5622,7 +5377,7 @@ take_only_rootset([H|T]) ->
[H|take_only_rootset(T)].
check_unique_sequence_tags(S,CompList) ->
- TagComps = case complist_as_tuple(false,CompList) of
+ TagComps = case complist_as_tuple(CompList) of
{R1,Ext,R2} ->
R1 ++ [C#'ComponentType'{prop='OPTIONAL'}||
C = #'ComponentType'{} <- Ext]++R2;
@@ -5657,7 +5412,7 @@ check_unique_sequence_tags1(S,[],Acc) ->
check_unique_tags(S,lists:reverse(Acc)).
check_sequenceof(S,Type,Component) when is_record(Component,type) ->
- check_type(S,Type,Component).
+ simplify_type(check_type(S, Type, Component)).
check_set(S,Type,Components) ->
{TableCInf,NewComponents} = check_sequence(S,Type,Components),
@@ -5879,7 +5634,7 @@ extension({Root1,ExtList,Root2}) ->
X = #'ComponentType'{prop=Y}<-ExtList], Root2}.
check_setof(S,Type,Component) when is_record(Component,type) ->
- check_type(S,Type,Component).
+ simplify_type(check_type(S, Type, Component)).
check_selectiontype(S,Name,#type{def=Eref})
when is_record(Eref,'Externaltypereference') ->
@@ -5943,8 +5698,9 @@ check_choice(S,Type,Components) when is_list(Components) ->
('ExtensionAdditionGroupEnd') -> false;
(_) -> true
end,NewComps),
- check_unique_tags(S,NewComps2),
- complist_as_tuple(is_erule_per(S#state.erule),NewComps2);
+ NewComps3 = simplify_comps(NewComps2),
+ check_unique_tags(S, NewComps3),
+ complist_as_tuple(NewComps3);
Dupl ->
throw({error,{asn1,{duplicate_choice_alternatives,Dupl}}})
end;
@@ -6322,7 +6078,7 @@ get_simple_table_info1(S,#'ComponentType'{typespec=TS},Cnames,Path) ->
simple_table_info(S,#'ObjectClassFieldType'{classname=ClRef,
class=ObjectClass,
fieldname=FieldName},Path) ->
-
+
ObjectClassFieldName =
case FieldName of
{LastFieldName,[]} -> LastFieldName;
@@ -6875,9 +6631,6 @@ get_OCFType(S,Fields,[PrimFieldName|Rest]) ->
get_taglist(S,Ext) when is_record(Ext,'Externaltypereference') ->
{_,T} = get_referenced_type(S,Ext),
get_taglist(S,T#typedef.typespec);
-get_taglist(S,Tref) when is_record(Tref,typereference) ->
- {_,T} = get_referenced_type(S,Tref),
- get_taglist(S,T#typedef.typespec);
get_taglist(S,Type) when is_record(Type,type) ->
case Type#type.tag of
[] ->
@@ -7047,60 +6800,27 @@ storeindb(S,M) when is_record(M,module) ->
NewM = M#module{typeorval=findtypes_and_values(TVlist)},
asn1_db:dbnew(NewM#module.name),
asn1_db:dbput(NewM#module.name,'MODULE', NewM),
- Res = storeindb(NewM#module.name,TVlist,[]),
+ Res = storeindb(#state{mname=NewM#module.name}, TVlist, []),
include_default_class(S,NewM#module.name),
include_default_type(NewM#module.name),
Res.
-storeindb(Module,[H|T],ErrAcc) when is_record(H,typedef) ->
- storeindb(Module,H#typedef.name,H,T,ErrAcc);
-storeindb(Module,[H|T],ErrAcc) when is_record(H,valuedef) ->
- storeindb(Module,H#valuedef.name,H,T,ErrAcc);
-storeindb(Module,[H|T],ErrAcc) when is_record(H,ptypedef) ->
- storeindb(Module,H#ptypedef.name,H,T,ErrAcc);
-storeindb(Module,[H|T],ErrAcc) when is_record(H,classdef) ->
- storeindb(Module,H#classdef.name,H,T,ErrAcc);
-storeindb(Module,[H|T],ErrAcc) when is_record(H,pvaluesetdef) ->
- storeindb(Module,H#pvaluesetdef.name,H,T,ErrAcc);
-storeindb(Module,[H|T],ErrAcc) when is_record(H,pobjectdef) ->
- storeindb(Module,H#pobjectdef.name,H,T,ErrAcc);
-storeindb(Module,[H|T],ErrAcc) when is_record(H,pvaluedef) ->
- storeindb(Module,H#pvaluedef.name,H,T,ErrAcc);
-storeindb(_,[],[]) -> ok;
-storeindb(_,[],ErrAcc) ->
- {error,ErrAcc}.
-
-storeindb(Module,Name,H,T,ErrAcc) ->
- case asn1_db:dbget(Module,Name) of
+storeindb(#state{mname=Module}=S, [H|T], Errors) ->
+ Name = asn1ct:get_name_of_def(H),
+ case asn1_db:dbget(Module, Name) of
undefined ->
- asn1_db:dbput(Module,Name,H),
- storeindb(Module,T,ErrAcc);
- _ ->
- case H of
- _Type when is_record(H,typedef) ->
- error({type,"already defined",
- #state{mname=Module,type=H,tname=Name}});
- _Type when is_record(H,valuedef) ->
- error({value,"already defined",
- #state{mname=Module,value=H,vname=Name}});
- _Type when is_record(H,ptypedef) ->
- error({ptype,"already defined",
- #state{mname=Module,type=H,tname=Name}});
- _Type when is_record(H,pobjectdef) ->
- error({ptype,"already defined",
- #state{mname=Module,type=H,tname=Name}});
- _Type when is_record(H,pvaluesetdef) ->
- error({ptype,"already defined",
- #state{mname=Module,type=H,tname=Name}});
- _Type when is_record(H,pvaluedef) ->
- error({ptype,"already defined",
- #state{mname=Module,type=H,tname=Name}});
- _Type when is_record(H,classdef) ->
- error({class,"already defined",
- #state{mname=Module,value=H,vname=Name}})
- end,
- storeindb(Module,T,[H|ErrAcc])
- end.
+ asn1_db:dbput(Module, Name, H),
+ storeindb(S, T, Errors);
+ Prev ->
+ PrevLine = asn1ct:get_pos_of_def(Prev),
+ {error,Error} = asn1_error(S, H, {already_defined,Name,PrevLine}),
+ storeindb(S, T, [Error|Errors])
+ end;
+storeindb(_, [], []) ->
+ ok;
+storeindb(_, [], [_|_]=Errors) ->
+ {error,Errors}.
+
findtypes_and_values(TVList) ->
findtypes_and_values(TVList,[],[],[],[],[],[]).%% Types,Values,
@@ -7140,8 +6860,20 @@ findtypes_and_values([],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) ->
{lists:reverse(Tacc),lists:reverse(Vacc),lists:reverse(Pacc),
lists:reverse(Cacc),lists:reverse(Oacc),lists:reverse(OSacc)}.
-
-
+asn1_error(#state{mname=Where}, Item, Error) ->
+ Pos = asn1ct:get_pos_of_def(Item),
+ {error,{structured_error,{Where,Pos},?MODULE,Error}}.
+
+format_error({already_defined,Name,PrevLine}) ->
+ io_lib:format("the name ~p has already been defined at line ~p",
+ [Name,PrevLine]);
+format_error({undefined,Name}) ->
+ io_lib:format("'~s' is referenced, but is not defined", [Name]);
+format_error(Other) ->
+ io_lib:format("~p", [Other]).
+
+error({_,{structured_error,_,_,_}=SE,_}) ->
+ SE;
error({export,Msg,#state{mname=Mname,type=Ref,tname=Typename}}) ->
Pos = Ref#'Externaltypereference'.pos,
io:format("asn1error:~p:~p:~p~n~p~n",[Pos,Mname,Typename,Msg]),
@@ -7444,3 +7176,13 @@ insert_once(S,Tab,Key) ->
_ ->
skipped
end.
+
+check_fold(S, [H|T], Check) ->
+ Type = asn1_db:dbget(S#state.mname, H),
+ case Check(S, H, Type) of
+ ok ->
+ check_fold(S, T, Check);
+ Error ->
+ [Error|check_fold(S, T, Check)]
+ end;
+check_fold(_, [], Check) when is_function(Check, 3) -> [].