aboutsummaryrefslogtreecommitdiffstats
path: root/lib/asn1/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/asn1/src')
-rw-r--r--lib/asn1/src/Makefile1
-rw-r--r--lib/asn1/src/asn1_db.erl8
-rw-r--r--lib/asn1/src/asn1_records.hrl16
-rw-r--r--lib/asn1/src/asn1ct.erl71
-rw-r--r--lib/asn1/src/asn1ct_check.erl5271
-rw-r--r--lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl13
-rw-r--r--lib/asn1/src/asn1ct_constructed_per.erl155
-rw-r--r--lib/asn1/src/asn1ct_gen.erl75
-rw-r--r--lib/asn1/src/asn1ct_gen_ber_bin_v2.erl109
-rw-r--r--lib/asn1/src/asn1ct_imm.erl9
-rw-r--r--lib/asn1/src/asn1ct_parser.yrl1177
-rw-r--r--lib/asn1/src/asn1ct_parser2.erl2517
-rw-r--r--lib/asn1/src/asn1ct_tok.erl332
13 files changed, 3334 insertions, 6420 deletions
diff --git a/lib/asn1/src/Makefile b/lib/asn1/src/Makefile
index 6798da0072..40f440423d 100644
--- a/lib/asn1/src/Makefile
+++ b/lib/asn1/src/Makefile
@@ -206,6 +206,7 @@ $(EBIN)/asn1ct_constructed_per.beam: asn1ct_constructed_per.erl asn1_records.hrl
$(EBIN)/asn1ct_func.beam: asn1ct_func.erl
$(EBIN)/asn1ct_gen.beam: asn1ct_gen.erl asn1_records.hrl
$(EBIN)/asn1ct_gen_ber_bin_v2.beam: asn1ct_gen_ber_bin_v2.erl asn1_records.hrl
+$(EBIN)/asn1ct_gen_check.beam: asn1_records.hrl
$(EBIN)/asn1ct_gen_per.beam: asn1ct_gen_per.erl asn1_records.hrl
$(EBIN)/asn1ct_gen_per_rt2ct.beam: asn1ct_gen_per_rt2ct.erl asn1_records.hrl
$(EBIN)/asn1ct_imm.beam: asn1ct_imm.erl
diff --git a/lib/asn1/src/asn1_db.erl b/lib/asn1/src/asn1_db.erl
index 48d9dd16d7..5577969727 100644
--- a/lib/asn1/src/asn1_db.erl
+++ b/lib/asn1/src/asn1_db.erl
@@ -19,7 +19,8 @@
%%
-module(asn1_db).
--export([dbstart/1,dbnew/2,dbload/1,dbload/3,dbsave/2,dbput/3,dbget/2]).
+-export([dbstart/1,dbnew/2,dbload/1,dbload/3,dbsave/2,dbput/2,
+ dbput/3,dbget/2]).
-export([dbstop/0]).
-record(state, {parent, monitor, includes, table}).
@@ -44,6 +45,7 @@ dbload(Module) ->
dbnew(Module, Erule) -> req({new, Module, Erule}).
dbsave(OutFile, Module) -> cast({save, OutFile, Module}).
dbput(Module, K, V) -> cast({set, Module, K, V}).
+dbput(Module, Kvs) -> cast({set, Module, Kvs}).
dbget(Module, K) -> req({get, Module, K}).
dbstop() -> Resp = req(stop), erase(?MODULE), Resp.
@@ -82,6 +84,10 @@ loop(#state{parent = Parent, monitor = MRef, table = Table,
[{_, Modtab}] = ets:lookup(Table, Mod),
ets:insert(Modtab, {K2, V}),
loop(State);
+ {set, Mod, Kvs} ->
+ [{_, Modtab}] = ets:lookup(Table, Mod),
+ ets:insert(Modtab, Kvs),
+ loop(State);
{From, {get, Mod, K2}} ->
%% XXX If there is no information for Mod, get_table/3
%% will attempt to load information from an .asn1db
diff --git a/lib/asn1/src/asn1_records.hrl b/lib/asn1/src/asn1_records.hrl
index 6c1cf1b12a..84435b2d21 100644
--- a/lib/asn1/src/asn1_records.hrl
+++ b/lib/asn1/src/asn1_records.hrl
@@ -81,9 +81,19 @@
module :: atom(),
val :: atom()}).
--record(state,{module,mname,type,tname,value,vname,erule,parameters=[],
- inputmodules,abscomppath=[],recordtopname=[],options,
- sourcedir}).
+-record(state,
+ {module,
+ mname,
+ tname,
+ erule,
+ parameters=[],
+ inputmodules=[],
+ abscomppath=[],
+ recordtopname=[],
+ options,
+ sourcedir,
+ error_context %Top-level thingie (contains line numbers)
+ }).
%% state record used by back-end at partial decode
%% active is set to 'yes' when a partial decode function is generated.
diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl
index df341e5aab..a26d63c97d 100644
--- a/lib/asn1/src/asn1ct.erl
+++ b/lib/asn1/src/asn1ct.erl
@@ -34,7 +34,8 @@
%% Application internal exports
-export([compile_asn/3,compile_asn1/3,compile_py/3,compile/3,
vsn/0,
- get_name_of_def/1,get_pos_of_def/1]).
+ get_name_of_def/1,get_pos_of_def/1,
+ unset_pos_mod/1]).
-export([read_config_data/1,get_gen_state_field/1,
partial_inc_dec_toptype/1,update_gen_state/2,
get_tobe_refed_func/1,reset_gen_state/0,is_function_generated/1,
@@ -166,46 +167,26 @@ set_scan_parse_pass(#st{files=Files}=St) ->
{error,St#st{error=Error}}
end.
-set_scan_parse_pass_1([F|Fs], St) ->
+set_scan_parse_pass_1([F|Fs], #st{file=File}=St) ->
case asn1ct_tok:file(F) of
{error,Error} ->
throw(Error);
Tokens when is_list(Tokens) ->
- case catch asn1ct_parser2:parse(Tokens) of
+ case asn1ct_parser2:parse(File, Tokens) of
{ok,M} ->
[M|set_scan_parse_pass_1(Fs, St)];
- {error,ErrorTerm} ->
- throw(handle_parse_error(ErrorTerm, St))
+ {error,Errors} ->
+ throw(Errors)
end
end;
set_scan_parse_pass_1([], _) -> [].
-parse_pass(#st{code=Tokens}=St) ->
- case catch asn1ct_parser2:parse(Tokens) of
+parse_pass(#st{file=File,code=Tokens}=St) ->
+ case asn1ct_parser2:parse(File, Tokens) of
{ok,M} ->
{ok,St#st{code=M}};
- {error,ErrorTerm} ->
- {error,St#st{error=handle_parse_error(ErrorTerm, St)}}
- end.
-
-handle_parse_error(ErrorTerm, #st{file=File,opts=Opts}) ->
- case ErrorTerm of
- {{Line,_Mod,Message},_TokTup} ->
- if
- is_integer(Line) ->
- BaseName = filename:basename(File),
- error("syntax error at line ~p in module ~s:~n",
- [Line,BaseName], Opts);
- true ->
- error("syntax error in module ~p:~n",
- [File], Opts)
- end,
- print_error_message(Message),
- Message;
- {Line,_Mod,[Message,Token]} ->
- error("syntax error: ~p ~p at line ~p~n",
- [Message,Token,Line], Opts),
- {Line,[Message,Token]}
+ {error,Errors} ->
+ {error,St#st{error=Errors}}
end.
merge_pass(#st{file=Base,code=Code}=St) ->
@@ -559,7 +540,10 @@ unset_pos_mod(Def) when is_record(Def,pvaluesetdef) ->
unset_pos_mod(Def) when is_record(Def,pobjectdef) ->
Def#pobjectdef{pos=undefined};
unset_pos_mod(Def) when is_record(Def,pobjectsetdef) ->
- Def#pobjectsetdef{pos=undefined}.
+ Def#pobjectsetdef{pos=undefined};
+unset_pos_mod(#'ComponentType'{} = Def) ->
+ Def#'ComponentType'{pos=undefined};
+unset_pos_mod(Def) -> Def.
get_pos_of_def(#typedef{pos=Pos}) ->
Pos;
@@ -1406,33 +1390,6 @@ prepare_bytes(Bytes) -> list_to_binary(Bytes).
vsn() ->
?vsn.
-
-
-print_error_message([got,H|T]) when is_list(H) ->
- io:format(" got:"),
- print_listing(H,"and"),
- print_error_message(T);
-print_error_message([expected,H|T]) when is_list(H) ->
- io:format(" expected one of:"),
- print_listing(H,"or"),
- print_error_message(T);
-print_error_message([H|T]) ->
- io:format(" ~p",[H]),
- print_error_message(T);
-print_error_message([]) ->
- io:format("~n").
-
-print_listing([H1,H2|[]],AndOr) ->
- io:format(" ~p ~s ~p",[H1,AndOr,H2]);
-print_listing([H1,H2|T],AndOr) ->
- io:format(" ~p,",[H1]),
- print_listing([H2|T],AndOr);
-print_listing([H],_AndOr) ->
- io:format(" ~p",[H]);
-print_listing([],_) ->
- ok.
-
-
specialized_decode_prepare(Erule,M,TsAndVs,Options) ->
case lists:member(asn1config,Options) of
true ->
diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl
index 240f1cbb16..99392d6eaa 100644
--- a/lib/asn1/src/asn1ct_check.erl
+++ b/lib/asn1/src/asn1ct_check.erl
@@ -23,8 +23,6 @@
%% Main Module for ASN.1 compile time functions
%-compile(export_all).
-%% Avoid warning for local function error/1 clashing with autoimported BIF.
--compile({no_auto_import,[error/1]}).
-export([check/2,storeindb/2,format_error/1]).
%-define(debug,1).
-include("asn1_records.hrl").
@@ -60,17 +58,9 @@
-define(N_BMPString, 30).
-define(TAG_PRIMITIVE(Num),
- case S#state.erule of
- ber ->
- #tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=0};
- _ -> []
- end).
+ #tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=0}).
-define(TAG_CONSTRUCTED(Num),
- case S#state.erule of
- ber ->
- #tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=32};
- _ -> []
- end).
+ #tag{class='UNIVERSAL',number=Num,type='IMPLICIT',form=32}).
-record(newt,{type=unchanged,tag=unchanged,constraint=unchanged,inlined=no}). % used in check_type to update type and tag
@@ -249,26 +239,18 @@ check_exports(S,Module = #module{}) ->
{exports,all} ->
[];
{exports,ExportList} when is_list(ExportList) ->
- IsNotDefined =
+ IsNotDefined =
fun(X) ->
- case catch get_referenced_type(S,X) of
- {error,{asn1,_}} ->
- true;
- _ -> false
+ try
+ _ = get_referenced_type(S,X),
+ false
+ catch {error,_} ->
+ true
end
end,
- case lists:filter(IsNotDefined,ExportList) of
- [] ->
- [];
- NoDefExp ->
- GetName =
- fun(T = #'Externaltypereference'{type=N})->
- %%{exported,undefined,entity,N}
- NewS=S#state{type=T,tname=N},
- error({export,"exported undefined entity",NewS})
- end,
- lists:map(GetName,NoDefExp)
- end
+ [return_asn1_error(S, Ext, {undefined_export, Undef}) ||
+ Ext = #'Externaltypereference'{type=Undef} <- ExportList,
+ IsNotDefined(Ext)]
end.
check_imports(S, #module{imports={imports,Imports}}) ->
@@ -276,53 +258,18 @@ check_imports(S, #module{imports={imports,Imports}}) ->
check_imports_1(_S, [], Acc) ->
Acc;
-check_imports_1(S, [#'SymbolsFromModule'{symbols=Imports,module=ModuleRef}|SFMs], Acc0) ->
+check_imports_1(S, [#'SymbolsFromModule'{symbols=Imports,module=ModuleRef}|SFMs], Acc) ->
Module = name_of_def(ModuleRef),
- Refs0 = [{catch get_referenced_type(S, Ref),Ref} || Ref <- Imports],
- Refs = [{M,R} || {{M,_},R} <- Refs0],
- {Illegal,Other} = lists:splitwith(fun({error,_}) -> true;
- (_) -> false
- end, Refs),
- ChainedRefs = [R || {M,R} <- Other, M =/= Module],
- IllegalRefs = [R || {error,R} <- Illegal] ++
- [R || {M,R} <- ChainedRefs,
- ok =/= chained_import(S, Module, M, name_of_def(R))],
- Acc = [return_asn1_error(S, Ref, {undefined_import,name_of_def(Ref),Module}) ||
- Ref <- IllegalRefs] ++ Acc0,
- check_imports_1(S, SFMs, Acc).
-
-chained_import(S,ImpMod,DefMod,Name) ->
- %% Name is a referenced structure that is not defined in ImpMod,
- %% but must be present in the Imports list of ImpMod. The chain of
- %% imports of Name must end in DefMod.
- GetImports =
- fun(_M_) ->
- case asn1_db:dbget(_M_,'MODULE') of
- #module{imports={imports,ImportList}} ->
- ImportList;
- _ -> []
- end
- end,
- FindNameInImports =
- fun([],N,_) -> {no_mod,N};
- ([#'SymbolsFromModule'{symbols=Imports,module=ModuleRef}|SFMs],N,F) ->
- case [name_of_def(X) || X <- Imports, name_of_def(X) =:= N] of
- [] -> F(SFMs,N,F);
- [N] -> {name_of_def(ModuleRef),N}
- end
- end,
- case GetImports(ImpMod) of
- [] ->
- error;
- Imps ->
- case FindNameInImports(Imps,Name,FindNameInImports) of
- {no_mod,_} ->
- error;
- {DefMod,_} -> ok;
- {OtherMod,_} ->
- chained_import(S,OtherMod,DefMod,Name)
- end
- end.
+ Refs = [{try get_referenced_type(S, Ref)
+ catch throw:Error -> Error end,
+ Ref}
+ || Ref <- Imports],
+ CreateError = fun(Ref) ->
+ Error = {undefined_import,name_of_def(Ref),Module},
+ return_asn1_error(S, Ref, Error)
+ end,
+ Errors = [CreateError(Ref) || {{error, _}, Ref} <- Refs],
+ check_imports_1(S, SFMs, Errors ++ Acc).
checkt(S0, Names) ->
Check = fun do_checkt/3,
@@ -335,7 +282,7 @@ checkt(S0, Names) ->
check_fold(S0, lists:reverse(CtxtSwitch), Check) ++ Types.
do_checkt(S, Name, #typedef{typespec=TypeSpec}=Type0) ->
- NewS = S#state{type=Type0,tname=Name},
+ NewS = S#state{tname=Name},
try check_type(NewS, Type0, TypeSpec) of
#type{}=Ts ->
case Type0#typedef.checked of
@@ -350,7 +297,7 @@ do_checkt(S, Name, #typedef{typespec=TypeSpec}=Type0) ->
end
catch
{error,Reason} ->
- error({type,Reason,NewS});
+ Reason;
{asn1_class,_ClassDef} ->
{asn1_class,Name};
pobjectsetdef ->
@@ -384,33 +331,32 @@ do_checkv(S, Name, Value)
is_record(Value, typedef); %Value set may be parsed as object set.
is_record(Value, pvaluedef);
is_record(Value, pvaluesetdef) ->
- NewS = S#state{value=Value},
- try check_value(NewS, Value) of
+ try check_value(S, Value) of
{valueset,VSet} ->
Pos = asn1ct:get_pos_of_def(Value),
CheckedVSDef = #typedef{checked=true,pos=Pos,
name=Name,typespec=VSet},
- asn1_db:dbput(NewS#state.mname, Name, CheckedVSDef),
+ asn1_db:dbput(S#state.mname, Name, CheckedVSDef),
{valueset,Name};
V ->
%% update the valuedef
- asn1_db:dbput(NewS#state.mname, Name, V),
+ asn1_db:dbput(S#state.mname, Name, V),
ok
catch
{error,Reason} ->
- error({value,Reason,NewS});
+ Reason;
{pobjectsetdef} ->
{pobjectsetdef,Name};
{objectsetdef} ->
{objectsetdef,Name};
- {objectdef} ->
+ {asn1_class, _} ->
%% this is an object, save as typedef
#valuedef{checked=C,pos=Pos,name=N,type=Type,
value=Def} = Value,
ClassName = Type#type.def,
NewSpec = #'Object'{classname=ClassName,def=Def},
NewDef = #typedef{checked=C,pos=Pos,name=N,typespec=NewSpec},
- asn1_db:dbput(NewS#state.mname, Name, NewDef),
+ asn1_db:dbput(S#state.mname, Name, NewDef),
{objectdef,Name}
end.
@@ -419,7 +365,7 @@ checkp(S, Names) ->
check_fold(S, Names, fun do_checkp/3).
do_checkp(S0, Name, #ptypedef{typespec=TypeSpec}=Type0) ->
- S = S0#state{type=Type0,tname=Name},
+ S = S0#state{tname=Name},
try check_ptype(S, Type0, TypeSpec) of
#type{}=Ts ->
Type = Type0#ptypedef{checked=true,typespec=Ts},
@@ -427,7 +373,7 @@ do_checkp(S0, Name, #ptypedef{typespec=TypeSpec}=Type0) ->
ok
catch
{error,Reason} ->
- error({type,Reason,S});
+ Reason;
{asn1_class,_ClassDef} ->
{asn1_class,Name};
{asn1_param_class,_} ->
@@ -438,100 +384,81 @@ do_checkp(S0, Name, #ptypedef{typespec=TypeSpec}=Type0) ->
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,
- 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.
+do_checkc(S, Name, Class) ->
+ try
+ case is_classname(Name) of
+ false ->
+ asn1_error(S, {illegal_class_name,Name});
+ true ->
+ do_checkc_1(S, Name, Class)
+ end
+ catch {error,Reason} -> Reason
+ end.
+
+do_checkc_1(S, Name, #classdef{}=Class) ->
+ C = check_class(S, Class),
+ store_class(S, true, Class#classdef{typespec=C}, Name),
+ ok;
+do_checkc_1(S, Name, #typedef{typespec=#type{def=Def}=TS}) ->
+ C = check_class(S, TS),
+ {Mod,Pos} = case Def of
+ #'Externaltypereference'{module=M, pos=P} ->
+ {M,P};
+ {pt, #'Externaltypereference'{module=M, pos=P}, _} ->
+ {M,P}
+ end,
+ Class = #classdef{name=Name, typespec=C, pos=Pos, module=Mod},
+ store_class(S, true, Class, Name),
+ ok.
+
+%% is_classname(Atom) -> true|false.
+is_classname(Name) when is_atom(Name) ->
+ lists:all(fun($-) -> true;
+ (D) when $0 =< D, D =< $9 -> true;
+ (UC) when $A =< UC, UC =< $Z -> true;
+ (_) -> false
+ end, atom_to_list(Name)).
-checko(S,[Name|Os],Acc,ExclO,ExclOS) ->
- ?dbg("Checking object ~p~n",[Name]),
- Result =
- case asn1_db:dbget(S#state.mname,Name) of
- undefined ->
- error({type,{internal_error,'???'},S});
- Object when is_record(Object,typedef) ->
- NewS = S#state{type=Object,tname=Name},
- case catch(check_object(NewS,Object,Object#typedef.typespec)) of
- {error,Reason} ->
- error({type,Reason,NewS});
- {'EXIT',Reason} ->
- error({type,{internal_error,Reason},NewS});
- {asn1,Reason} ->
- error({type,Reason,NewS});
- O ->
- NewObj = Object#typedef{checked=true,typespec=O},
- asn1_db:dbput(NewS#state.mname,Name,NewObj),
- if
- is_record(O,'Object') ->
- case O#'Object'.gen of
- true ->
- {ok,ExclO,ExclOS};
- false ->
- {ok,[Name|ExclO],ExclOS}
- end;
- is_record(O,'ObjectSet') ->
- case O#'ObjectSet'.gen of
- true ->
- {ok,ExclO,ExclOS};
- false ->
- {ok,ExclO,[Name|ExclOS]}
- end
- end
- end;
- PObject when is_record(PObject,pobjectdef) ->
- NewS = S#state{type=PObject,tname=Name},
- case (catch check_pobject(NewS,PObject)) of
- {error,Reason} ->
- error({type,Reason,NewS});
- {'EXIT',Reason} ->
- error({type,{internal_error,Reason},NewS});
- {asn1,Reason} ->
- error({type,Reason,NewS});
- PO ->
- NewPObj = PObject#pobjectdef{def=PO},
- asn1_db:dbput(NewS#state.mname,Name,NewPObj),
- {ok,[Name|ExclO],ExclOS}
- end;
- PObjSet when is_record(PObjSet,pvaluesetdef) ->
- %% this is a parameterized object set. Might be a parameterized
- %% value set, couldn't it?
- NewS = S#state{type=PObjSet,tname=Name},
- case (catch check_pobjectset(NewS,PObjSet)) of
- {error,Reason} ->
- error({type,Reason,NewS});
- {'EXIT',Reason} ->
- error({type,{internal_error,Reason},NewS});
- {asn1,Reason} ->
- error({type,Reason,NewS});
- POS ->
- %%NewPObjSet = PObjSet#pvaluesetdef{valueset=POS},
- asn1_db:dbput(NewS#state.mname,Name,POS),
- {ok,ExclO,[Name|ExclOS]}
- end
- end,
- case Result of
- {ok,NewExclO,NewExclOS} ->
- checko(S,Os,Acc,NewExclO,NewExclOS);
- _ ->
- checko(S,Os,[Result|Acc],ExclO,ExclOS)
+checko(S0,[Name|Os],Acc,ExclO,ExclOS) ->
+ Item = asn1_db:dbget(S0#state.mname, Name),
+ S = S0#state{error_context=Item},
+ try checko_1(S, Item, Name, ExclO, ExclOS) of
+ {NewExclO,NewExclOS} ->
+ checko(S, Os, Acc, NewExclO, NewExclOS)
+ catch
+ throw:{error, Error} ->
+ checko(S, Os, [Error|Acc], ExclO, ExclOS)
end;
checko(_S,[],Acc,ExclO,ExclOS) ->
{lists:reverse(Acc),lists:reverse(ExclO),lists:reverse(ExclOS)}.
+checko_1(S, #typedef{typespec=TS}=Object, Name, ExclO, ExclOS) ->
+ NewS = S#state{tname=Name},
+ O = check_object(NewS, Object, TS),
+ NewObj = Object#typedef{checked=true,typespec=O},
+ asn1_db:dbput(NewS#state.mname, Name, NewObj),
+ case O of
+ #'Object'{gen=true} ->
+ {ExclO,ExclOS};
+ #'Object'{gen=false} ->
+ {[Name|ExclO],ExclOS};
+ #'ObjectSet'{gen=true} ->
+ {ExclO,ExclOS};
+ #'ObjectSet'{gen=false} ->
+ {ExclO,[Name|ExclOS]}
+ end;
+checko_1(S, #pobjectdef{}=PObject, Name, ExclO, ExclOS) ->
+ NewS = S#state{tname=Name},
+ PO = check_pobject(NewS, PObject),
+ NewPObj = PObject#pobjectdef{def=PO},
+ asn1_db:dbput(NewS#state.mname, Name, NewPObj),
+ {[Name|ExclO],ExclOS};
+checko_1(S, #pvaluesetdef{}=PObjSet, Name, ExclO, ExclOS) ->
+ NewS = S#state{tname=Name},
+ POS = check_pobjectset(NewS, PObjSet),
+ asn1_db:dbput(NewS#state.mname, Name, POS),
+ {ExclO,[Name|ExclOS]}.
+
check_class(S,CDef=#classdef{checked=Ch,name=Name,typespec=TS}) ->
case Ch of
true -> TS;
@@ -551,22 +478,16 @@ check_class(S = #state{mname=M,tname=T},ClassSpec)
Tref = #'Externaltypereference'{type=TName} ->
{MName,RefType} = get_referenced_type(S,Tref),
#classdef{} = CD = get_class_def(S, RefType),
- NewState = update_state(S#state{type=RefType,
- tname=TName}, MName),
+ NewState = update_state(S#state{tname=TName}, MName),
check_class(NewState, CD);
{pt,ClassRef,Params} ->
%% parameterized class
{_,PClassDef} = get_referenced_type(S,ClassRef),
- NewParaList =
- [match_parameters(S,TmpParam,S#state.parameters)||
- TmpParam <- Params],
+ NewParaList = match_parameters(S, Params),
instantiate_pclass(S,PClassDef,NewParaList)
end;
-check_class(S,C) when is_record(C,objectclass) ->
- NewFieldSpec = check_class_fields(S,C#objectclass.fields),
- C#objectclass{fields=NewFieldSpec};
-check_class(_S,{poc,_ObjSet,_Params}) ->
- 'fix this later';
+check_class(S, #objectclass{}=C) ->
+ check_objectclass(S, C);
check_class(S,ClassName) ->
{RefMod,Def} = get_referenced_type(S,ClassName),
case Def of
@@ -579,8 +500,7 @@ check_class(S,ClassName) ->
false ->
Name=ClassName#'Externaltypereference'.type,
store_class(S,idle,ClassDef,Name),
-% NewS = S#state{mname=RefMod,type=Def,tname=Name},
- NewS = update_state(S#state{type=Def,tname=Name},RefMod),
+ NewS = update_state(S#state{tname=Name}, RefMod),
CheckedTS = check_class(NewS,ClassDef#classdef.typespec),
store_class(S,true,ClassDef#classdef{typespec=CheckedTS},Name),
CheckedTS
@@ -594,11 +514,20 @@ check_class(S,ClassName) ->
end
end.
+check_objectclass(S, #objectclass{fields=Fs0,syntax=Syntax0}=C) ->
+ Fs = check_class_fields(S, Fs0),
+ case Syntax0 of
+ {'WITH SYNTAX',Syntax1} ->
+ Syntax = preprocess_syntax(S, Syntax1, Fs),
+ C#objectclass{fields=Fs,syntax={preprocessed_syntax,Syntax}};
+ _ ->
+ C#objectclass{fields=Fs}
+ end.
+
instantiate_pclass(S=#state{parameters=_OldArgs},PClassDef,Params) ->
#ptypedef{args=Args,typespec=Type} = PClassDef,
MatchedArgs = match_args(S,Args, Params, []),
-% NewS = S#state{type=Type,parameters=MatchedArgs++OldArgs,abscomppath=[]},
- NewS = S#state{type=Type,parameters=MatchedArgs,abscomppath=[]},
+ NewS = S#state{parameters=MatchedArgs,abscomppath=[]},
check_class(NewS,#classdef{name=S#state.tname,typespec=Type}).
store_class(S,Mode,ClassDef,ClassName) ->
@@ -613,6 +542,12 @@ check_class_fields(S,[F|Fields],Acc) ->
case element(1,F) of
fixedtypevaluefield ->
{_,Name,Type,Unique,OSpec} = F,
+ case {Unique,OSpec} of
+ {'UNIQUE',{'DEFAULT',_}} ->
+ asn1_error(S, {unique_and_default,Name});
+ {_,_} ->
+ ok
+ end,
RefType = check_type(S,#typedef{typespec=Type},Type),
{fixedtypevaluefield,Name,RefType,Unique,OSpec};
object_or_fixedtypevalue_field ->
@@ -621,7 +556,7 @@ check_class_fields(S,[F|Fields],Acc) ->
Cat =
case asn1ct_gen:type(asn1ct_gen:get_inner(Type2#type.def)) of
Def when is_record(Def,'Externaltypereference') ->
- {_,D} = get_referenced_type(S,Def),
+ {_,D} = get_referenced_type(S, Def, true),
D;
{undefined,user} ->
%% neither of {primitive,bif} or {constructed,bif}
@@ -644,18 +579,14 @@ check_class_fields(S,[F|Fields],Acc) ->
objectset_or_fixedtypevalueset_field ->
{_,Name,Type,OSpec} = F,
RefType =
- case (catch check_type(S,#typedef{typespec=Type},Type)) of
- {asn1_class,_ClassDef} ->
+ try check_type(S,#typedef{typespec=Type},Type) of
+ #type{} = CheckedType ->
+ CheckedType
+ catch {asn1_class,_ClassDef} ->
case if_current_checked_type(S,Type) of
- true ->
- Type#type.def;
- _ ->
- check_class(S,Type)
- end;
- CheckedType when is_record(CheckedType,type) ->
- CheckedType;
- _ ->
- error({class,"internal error, check_class_fields",S})
+ true -> Type#type.def;
+ _ -> check_class(S,Type)
+ end
end,
if
is_record(RefType,'Externaltypereference') ->
@@ -733,38 +664,34 @@ check_pobjectset(S,PObjSet) ->
PObjSet
end.
+-record(osi, %Object set information.
+ {st,
+ classref,
+ uniq,
+ ext
+ }).
+
check_object(_S,ObjDef,ObjSpec) when (ObjDef#typedef.checked == true) ->
ObjSpec;
check_object(S,_ObjDef,#'Object'{classname=ClassRef,def=ObjectDef}) ->
?dbg("check_object ~p~n",[ObjectDef]),
-%% io:format("check_object,object: ~p~n",[ObjectDef]),
-% {MName,_ClassDef} = get_referenced_type(S,ClassRef),
- NewClassRef = check_externaltypereference(S,ClassRef),
- ClassDef =
- case get_referenced_type(S,ClassRef) of
- {MName,ClDef=#classdef{checked=false}} ->
- NewState = update_state(S#state{type=ClDef,
- tname=ClassRef#'Externaltypereference'.type},MName),
- ObjClass=
- check_class(NewState,ClDef),
- #classdef{checked=true,
- typespec=ObjClass};
- {_,_ClDef} when is_record(_ClDef,classdef) ->
- _ClDef;
- {MName,_TDef=#typedef{checked=false,pos=Pos,
- name=_TName,typespec=TS}} ->
- ClDef = #classdef{pos=Pos,name=_TName,typespec=TS},
- NewState = update_state(S#state{type=_TDef,
- tname=ClassRef#'Externaltypereference'.type},MName),
- ObjClass =
- check_class(NewState,ClDef),
- ClDef#classdef{checked=true,typespec=ObjClass};
- {_,_ClDef} ->
- _ClDef
+ _ = check_externaltypereference(S,ClassRef),
+ {ClassDef, NewClassRef} =
+ case get_referenced_type(S, ClassRef, true) of
+ {MName,#classdef{checked=false, name=CLName}=ClDef} ->
+ Type = ClassRef#'Externaltypereference'.type,
+ NewState = update_state(S#state{tname=Type}, MName),
+ ObjClass = check_class(NewState, ClDef),
+ {ClDef#classdef{checked=true, typespec=ObjClass},
+ #'Externaltypereference'{module=MName, type=CLName}};
+ {MName,#classdef{name=CLName}=ClDef} ->
+ {ClDef, #'Externaltypereference'{module=MName, type=CLName}};
+ _ ->
+ asn1_error(S, illegal_object)
end,
NewObj =
case ObjectDef of
- Def when is_tuple(Def), (element(1,Def)==object) ->
+ {object,_,_}=Def ->
NewSettingList = check_objectdefn(S,Def,ClassDef),
#'Object'{def=NewSettingList};
{po,{object,DefObj},ArgsList} ->
@@ -778,425 +705,287 @@ check_object(S,_ObjDef,#'Object'{classname=ClassRef,def=ObjectDef}) ->
instantiate_po(S,ClassDef,Object,ArgList);
#'Externalvaluereference'{} ->
{_,Object} = get_referenced_type(S,ObjectDef),
- check_object(S,Object,Object#typedef.typespec);
+ check_object(S, Object, object_to_check(S, Object));
[] ->
- %% An object with no fields. All class fields must be
- %% optional or default. Check that all fields in
- %% class are 'OPTIONAL' or 'DEFAULT'
- class_fields_optional_check(S,ClassDef),
- #'Object'{def={object,defaultsyntax,[]}};
- _ ->
- exit({error,{no_object,ObjectDef},S})
+ %% An object with no fields (parsed as a value).
+ Def = {object,defaultsyntax,[]},
+ NewSettingList = check_objectdefn(S, Def, ClassDef),
+ #'Object'{def=NewSettingList};
+ _ ->
+ asn1_error(S, illegal_object)
end,
- Gen = gen_incl(S,NewObj#'Object'.def,
- (ClassDef#classdef.typespec)#objectclass.fields),
+ Fields = (ClassDef#classdef.typespec)#objectclass.fields,
+ Gen = gen_incl(S,NewObj#'Object'.def, Fields),
NewObj#'Object'{classname=NewClassRef,gen=Gen};
-
-
-check_object(S,
- _ObjSetDef,
- ObjSet=#'ObjectSet'{class=ClassRef}) ->
-%% io:format("check_object,SET: ~p~n",[ObjSet#'ObjectSet'.set]),
- ?dbg("check_object set: ~p~n",[ObjSet#'ObjectSet'.set]),
- {_,ClassDef} = get_referenced_type(S,ClassRef),
- NewClassRef = check_externaltypereference(S,ClassRef),
- {UniqueFieldName,UniqueInfo} =
- case (catch get_unique_fieldname(S,ClassDef)) of
- {error,'__undefined_',_} ->
- {{unique,undefined},{unique,undefined}};
- {asn1,Msg,_} -> error({class,Msg,S});
- {'EXIT',Msg} -> error({class,{internal_error,Msg},S});
+check_object(S, _, #'ObjectSet'{class=ClassRef0,set=Set0}=ObjSet0) ->
+ {_,ClassDef} = get_referenced_type(S, ClassRef0),
+ ClassRef = check_externaltypereference(S, ClassRef0),
+ {UniqueFieldName,UniqueInfo} =
+ case get_unique_fieldname(S, ClassDef) of
+ no_unique -> {{unique,undefined},{unique,undefined}};
Other -> {element(1,Other),Other}
end,
- NewObjSet=
- case prepare_objset(ObjSet#'ObjectSet'.set) of
- {set,SET,EXT} ->
- CheckedSet = check_object_list(S,NewClassRef,SET),
- NewSet = get_unique_valuelist(S,CheckedSet,UniqueInfo),
- ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
- set=extensionmark(NewSet,EXT)};
-
- {'SingleValue',ERef = #'Externalvaluereference'{}} ->
- {RefedMod,ObjDef} = get_referenced_type(S,ERef),
- #'Object'{def=CheckedObj} =
- check_object(S,ObjDef,ObjDef#typedef.typespec),
-
- NewSet = get_unique_valuelist(S,[{{RefedMod,get_datastr_name(ObjDef)},
- CheckedObj}],
- UniqueInfo),
- ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
- set=NewSet};
- ['EXTENSIONMARK'] ->
- ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
- set=['EXTENSIONMARK']};
-
- OSref when is_record(OSref,'Externaltypereference') ->
- {_,OS=#typedef{typespec=OSdef}} = get_referenced_type(S,OSref),
- check_object(S,OS,OSdef);
-
- {Type,{'EXCEPT',Exclusion}} when is_record(Type,type) ->
- {_,TDef} = get_referenced_type(S,Type#type.def),
- OS = TDef#typedef.typespec,
- NewSet = reduce_objectset(OS#'ObjectSet'.set,Exclusion),
- NewOS = OS#'ObjectSet'{set=NewSet},
- check_object(S,TDef#typedef{typespec=NewOS},
- NewOS);
- #type{def={pt,DefinedObjSet,ParamList}} ->
- {_,PObjSetDef} = get_referenced_type(S,DefinedObjSet),
- NewParamList =
- [match_parameters(S,TmpParam,S#state.parameters)||
- TmpParam <- ParamList],
- instantiate_pos(S,ClassRef,PObjSetDef,NewParamList);
-
- %% actually this is an ObjectSetFromObjects construct, it
- %% is when the object set is retrieved from an object
- %% field.
- #type{def=#'ObjectClassFieldType'{classname=ObjName,
- fieldname=FieldName}} ->
- {RefedObjMod,TDef} = get_referenced_type(S,ObjName),
- OS=TDef#typedef.typespec,
- %% should get the right object set here. Get the field
- %% FieldName out of the object set OS of class
- %% OS#'ObjectSet'.class
- OS2=check_object(S,TDef,OS),
- NewSet=object_set_from_objects(S,RefedObjMod,FieldName,OS2),
- ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
- set=NewSet};
- {'ObjectSetFromObjects',{_,_,ObjName},FieldName} ->
- {RefedObjMod,TDef} = get_referenced_type(S,ObjName),
- OS=TDef#typedef.typespec,
- %% should get the right object set here. Get the field
- %% FieldName out of the object set OS of class
- %% OS#'ObjectSet'.class
- OS2=check_object(S,TDef,OS),
- NewSet=object_set_from_objects(S,RefedObjMod,FieldName,OS2),
- ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
- set=NewSet};
- {'ObjectSetFromObjects',{_,ObjName},FieldName} ->
- %% This is a ObjectSetFromObjects, i.e.
- %% ObjectSetFromObjects ::= ReferencedObjects "." FieldName
- %% with a defined object as ReferencedObjects. And
- %% the FieldName of the Class (object) contains an object set.
- {RefedObjMod,TDef} = get_referenced_type(S,ObjName),
- O1 = TDef#typedef.typespec,
- O2 = check_object(S,TDef,O1),
- NewSet = object_set_from_objects(S,RefedObjMod,FieldName,O2),
- OS2=ObjSet#'ObjectSet'{uniquefname=UniqueFieldName,
- set=NewSet},
- %%io:format("ObjectSet: ~p~n",[OS2]),
- OS2;
- {pos,{objectset,_,DefinedObjSet},Params} ->
- {_,PObjSetDef} = get_referenced_type(S,DefinedObjSet),
- NewParamList =
- [match_parameters(S,TmpParam,S#state.parameters)||
- TmpParam <- Params],
- instantiate_pos(S,ClassRef,PObjSetDef,NewParamList);
- Unknown ->
- exit({error,{unknown_object_set,Unknown},S})
- end,
- NewSet2 = remove_duplicate_objects(NewObjSet#'ObjectSet'.set),
- NewObjSet2 = NewObjSet#'ObjectSet'{set=NewSet2},
- Gen = gen_incl_set(S,NewObjSet2#'ObjectSet'.set,
- ClassDef),
- ?dbg("check_object done~n",[]),
- NewObjSet2#'ObjectSet'{class=NewClassRef,gen=Gen}.
+ OSI0 = #osi{st=S,classref=ClassRef,uniq=UniqueInfo,ext=false},
+ {Set1,OSI1} = if
+ is_list(Set0) ->
+ check_object_set_list(Set0, OSI0);
+ true ->
+ check_object_set(Set0, OSI0)
+ end,
+ Ext = case Set1 of
+ [] ->
+ %% FIXME: X420 does not compile unless we force
+ %% empty sets to be extensible. There should be
+ %% a better way.
+ true;
+ [_|_] ->
+ OSI1#osi.ext
+ end,
+ Set2 = remove_duplicate_objects(S, Set1),
+ Set = case Ext of
+ false -> Set2;
+ true -> Set2 ++ ['EXTENSIONMARK']
+ end,
+ ObjSet = ObjSet0#'ObjectSet'{uniquefname=UniqueFieldName,set=Set},
+ Gen = gen_incl_set(S, Set, ClassDef),
+ ObjSet#'ObjectSet'{class=ClassRef,gen=Gen}.
+
+check_object_set({element_set,Root0,Ext0}, OSI0) ->
+ OSI = case Ext0 of
+ none -> OSI0;
+ _ -> OSI0#osi{ext=true}
+ end,
+ case {Root0,Ext0} of
+ {empty,empty} -> {[],OSI};
+ {empty,Ext} -> check_object_set(Ext, OSI);
+ {Root,none} -> check_object_set(Root, OSI);
+ {Root,empty} -> check_object_set(Root, OSI);
+ {Root,Ext} -> check_object_set_list([Root,Ext], OSI)
+ end;
+check_object_set(#'Externaltypereference'{}=Ref, #osi{st=S}=OSI) ->
+ {_,#typedef{typespec=OSdef}=OS} = get_referenced_type(S, Ref),
+ ObjectSet = check_object(S, OS, OSdef),
+ check_object_set_objset(ObjectSet, OSI);
+check_object_set(#'Externalvaluereference'{}=Ref, #osi{st=S}=OSI) ->
+ {RefedMod,ObjName,#'Object'{def=Def}} = check_referenced_object(S, Ref),
+ ObjList = check_object_set_mk(RefedMod, ObjName, Def, OSI),
+ {ObjList,OSI};
+check_object_set({'EXCEPT',Incl0,Excl0}, OSI) ->
+ {Incl1,_} = check_object_set(Incl0, OSI),
+ {Excl1,_} = check_object_set(Excl0, OSI),
+ Exclude = sofs:set([N || {N,_} <- Excl1], [name]),
+ Incl2 = [{Name,Obj} || {Name,_,_}=Obj <- Incl1],
+ Incl3 = sofs:relation(Incl2, [{name,object}]),
+ Incl4 = sofs:drestriction(Incl3, Exclude),
+ Incl5 = sofs:to_external(Incl4),
+ Incl = [Obj || {_,Obj} <- Incl5],
+ {Incl,OSI};
+check_object_set({object,_,_}=Obj0, OSI) ->
+ #osi{st=S,classref=ClassRef} = OSI,
+ #'Object'{def=Def} =
+ check_object(S, #typedef{typespec=Obj0},
+ #'Object'{classname=ClassRef,def=Obj0}),
+ ObjList = check_object_set_mk(Def, OSI),
+ {ObjList,OSI};
+check_object_set(#'ObjectClassFieldType'{classname=ObjName,
+ fieldname=FieldNames},
+ #osi{st=S}=OSI) ->
+ Set = check_ObjectSetFromObjects(S, ObjName, FieldNames),
+ check_object_set_objset_list(Set, OSI);
+check_object_set({'ObjectSetFromObjects',Obj,FieldNames}, #osi{st=S}=OSI) ->
+ ObjName = element(tuple_size(Obj), Obj),
+ Set = check_ObjectSetFromObjects(S, ObjName, FieldNames),
+ check_object_set_objset_list(Set, OSI);
+check_object_set({pt,DefinedObjSet,ParamList0}, OSI) ->
+ #osi{st=S,classref=ClassRef} = OSI,
+ {_,PObjSetDef} = get_referenced_type(S, DefinedObjSet),
+ ParamList = match_parameters(S, ParamList0),
+ ObjectSet = instantiate_pos(S, ClassRef, PObjSetDef, ParamList),
+ check_object_set_objset(ObjectSet, OSI);
+check_object_set({pos,{objectset,_,DefinedObjSet},Params0}, OSI) ->
+ #osi{st=S,classref=ClassRef} = OSI,
+ {_,PObjSetDef} = get_referenced_type(S, DefinedObjSet),
+ Params = match_parameters(S, Params0),
+ ObjectSet = instantiate_pos(S, ClassRef, PObjSetDef, Params),
+ check_object_set_objset(ObjectSet, OSI);
+check_object_set({pv,{simpledefinedvalue,DefinedObject},Params}=PV, OSI) ->
+ #osi{st=S,classref=ClassRef} = OSI,
+ Args = match_parameters(S, Params),
+ #'Object'{def=Def} =
+ check_object(S, PV,
+ #'Object'{classname=ClassRef ,
+ def={po,{object,DefinedObject},Args}}),
+ ObjList = check_object_set_mk(Def, OSI),
+ {ObjList,OSI};
+check_object_set({'SingleValue',Val}, OSI) ->
+ check_object_set(Val, OSI);
+check_object_set({'ValueFromObject',{object,Object},FieldNames}, OSI) ->
+ #osi{st=S} = OSI,
+ case extract_field(S, Object, FieldNames) of
+ #'Object'{def=Def} ->
+ ObjList = check_object_set_mk(Def, OSI),
+ {ObjList,OSI};
+ _ ->
+ asn1_error(S, illegal_object)
+ end;
+check_object_set(#type{def=Def}, OSI) ->
+ check_object_set(Def, OSI);
+check_object_set({union,A0,B0}, OSI0) ->
+ {A,OSI1} = check_object_set(A0, OSI0),
+ {B,OSI} = check_object_set(B0, OSI1),
+ {A++B,OSI}.
+
+check_object_set_list([H|T], OSI0) ->
+ {Set0,OSI1} = check_object_set(H, OSI0),
+ {Set1,OSI2} = check_object_set_list(T, OSI1),
+ {Set0++Set1,OSI2};
+check_object_set_list([], OSI) ->
+ {[],OSI}.
+
+check_object_set_objset(#'ObjectSet'{set=Set}, OSI) ->
+ check_object_set_objset_list(Set, OSI).
+
+check_object_set_objset_list(Set, OSI) ->
+ check_object_set_objset_list_1(Set, OSI, []).
+
+check_object_set_objset_list_1(['EXTENSIONMARK'|T], OSI, Acc) ->
+ check_object_set_objset_list_1(T, OSI#osi{ext=true}, Acc);
+check_object_set_objset_list_1([H|T], OSI, Acc) ->
+ check_object_set_objset_list_1(T, OSI, [H|Acc]);
+check_object_set_objset_list_1([], OSI, Acc) ->
+ {Acc,OSI}.
+
+check_object_set_mk(Fields, OSI) ->
+ check_object_set_mk(no_mod, no_name, Fields, OSI).
+
+check_object_set_mk(M, N, Def, #osi{uniq={unique,undefined}}) ->
+ {_,_,Fields} = Def,
+ [{{M,N},no_unique_value,Fields}];
+check_object_set_mk(M, N, Def, #osi{uniq={UniqField,_}}) ->
+ {_,_,Fields} = Def,
+ case lists:keyfind(UniqField, 1, Fields) of
+ {UniqField,#valuedef{value=Val}} ->
+ [{{M,N},Val,Fields}];
+ false ->
+ case Fields of
+ [{_,#typedef{typespec=#'ObjectSet'{set=['EXTENSIONMARK']}}}] ->
+ %% FIXME: If object is missing the unique field and
+ %% only contains a reference to an empty object set,
+ %% we will remove the entire object as a workaround
+ %% to get X420 to compile. There should be a better
+ %% way.
+ [];
+ _ ->
+ [{{M,N},no_unique_value,Fields}]
+ end
+ end.
%% remove_duplicate_objects/1 remove duplicates of objects.
%% For instance may Set contain objects of same class from
%% different object sets that in fact might be duplicates.
-remove_duplicate_objects(Set) when is_list(Set) ->
- Pred = fun({A,B,_},{A,C,_}) when B =< C -> true;
- ({A,_,_},{B,_,_}) when A < B -> true;
- ('EXTENSIONMARK','EXTENSIONMARK') -> true;
- (T,A) when is_tuple(T),is_atom(A) -> true;% EXTENSIONMARK last in list
- (_,_) -> false
- end,
- lists:usort(Pred,Set).
+remove_duplicate_objects(S, Set0) when is_list(Set0) ->
+ Set1 = [{Id,Orig} || {_,Id,_}=Orig <- Set0],
+ Set2 = sofs:relation(Set1),
+ Set3 = sofs:relation_to_family(Set2),
+ Set = sofs:to_external(Set3),
+ remove_duplicate_objects_1(S, Set).
+
+remove_duplicate_objects_1(S, [{no_unique_value,Objs}|T]) ->
+ Objs ++ remove_duplicate_objects_1(S, T);
+remove_duplicate_objects_1(S, [{_,[_]=Objs}|T]) ->
+ Objs ++ remove_duplicate_objects_1(S, T);
+remove_duplicate_objects_1(S, [{Id,[_|_]=Objs}|T]) ->
+ MakeSortable = fun(What) -> sortable_type(S, What) end,
+ Tagged = order_tag_set(Objs, MakeSortable),
+ case lists:ukeysort(1, Tagged) of
+ [{_,Obj}] ->
+ [Obj|remove_duplicate_objects_1(S, T)];
+ [_|_] ->
+ asn1_error(S, {non_unique_object,Id})
+ end;
+remove_duplicate_objects_1(_, []) ->
+ [].
-%%
-extensionmark(L,true) ->
- case lists:member('EXTENSIONMARK',L) of
- true -> L;
- _ -> L ++ ['EXTENSIONMARK']
+order_tag_set([{_, _, Fields}=Orig|Fs], Fun) ->
+ Pair = {[{FId, traverse(F, Fun)} || {FId, F} <- Fields], Orig},
+ [Pair|order_tag_set(Fs, Fun)];
+order_tag_set([], _) -> [].
+
+sortable_type(S, #'Externaltypereference'{}=ERef) ->
+ try get_referenced_type(S, ERef) of
+ {_,#typedef{}=OI} ->
+ OI#typedef{pos=undefined,name=undefined}
+ catch
+ _:_ ->
+ ERef
end;
-extensionmark(L,_) ->
- L.
+sortable_type(_, #typedef{}=TD) ->
+ asn1ct:unset_pos_mod(TD#typedef{name=undefined});
+sortable_type(_, Type) ->
+ asn1ct:unset_pos_mod(Type).
+
+traverse(Structure0, Fun) ->
+ Structure = Fun(Structure0),
+ traverse_1(Structure, Fun).
+
+traverse_1(#typedef{typespec=TS0} = TD, Fun) ->
+ TS = traverse(TS0, Fun),
+ TD#typedef{typespec=TS};
+traverse_1(#valuedef{type=TS0} = VD, Fun) ->
+ TS = traverse(TS0, Fun),
+ VD#valuedef{type=TS};
+traverse_1(#type{def=TS0} = TD, Fun) ->
+ TS = traverse(TS0, Fun),
+ TD#type{def=TS};
+traverse_1(#'SEQUENCE'{components=Cs0} = Seq, Fun) ->
+ Cs = traverse_seq_set(Cs0, Fun),
+ Seq#'SEQUENCE'{components=Cs};
+traverse_1({'SEQUENCE OF',Type0}, Fun) ->
+ Type = traverse(Type0, Fun),
+ {'SEQUENCE OF',Type};
+traverse_1({'SET OF',Type0}, Fun) ->
+ Type = traverse(Type0, Fun),
+ {'SET OF',Type};
+traverse_1(#'SET'{components=Cs0} = Set, Fun) ->
+ Cs = traverse_seq_set(Cs0, Fun),
+ Set#'SET'{components=Cs};
+traverse_1({'CHOICE', Cs0}, Fun) ->
+ Cs = traverse_seq_set(Cs0, Fun),
+ {'CHOICE', Cs};
+traverse_1(Leaf, _) ->
+ Leaf.
+
+traverse_seq_set(List, Fun) when is_list(List) ->
+ traverse_seq_set_1(List, Fun);
+traverse_seq_set({Set, Ext}, Fun) ->
+ {traverse_seq_set_1(Set, Fun), traverse_seq_set_1(Ext, Fun)};
+traverse_seq_set({Set1, Set2, Set3}, Fun) ->
+ {traverse_seq_set_1(Set1, Fun),
+ traverse_seq_set_1(Set2, Fun),
+ traverse_seq_set_1(Set3, Fun)}.
+
+traverse_seq_set_1([#'ComponentType'{} = CT0|Cs], Fun) ->
+ CT = #'ComponentType'{typespec=TS0} = Fun(CT0),
+ TS = traverse(TS0, Fun),
+ [CT#'ComponentType'{typespec=TS}|traverse_seq_set_1(Cs, Fun)];
+traverse_seq_set_1([{'COMPONENTS OF', _} = CO0|Cs], Fun) ->
+ {'COMPONENTS OF', TS0} = Fun(CO0),
+ TS = traverse(TS0, Fun),
+ [{'COMPONENTS OF', TS}|traverse_seq_set_1(Cs, Fun)];
+traverse_seq_set_1([], _) ->
+ [].
-object_to_check(#typedef{typespec=ObjDef}) ->
+object_to_check(_, #typedef{typespec=ObjDef}) ->
ObjDef;
-object_to_check(#valuedef{type=ClassName,value=ObjectRef}) ->
+object_to_check(S, #valuedef{type=Class,value=ObjectRef}) ->
%% If the object definition is parsed as an object the ClassName
- %% is parsed as a type
- #'Object'{classname=ClassName#type.def,def=ObjectRef}.
-
-prepare_objset({'SingleValue',Set}) when is_list(Set) ->
- {set,Set,false};
-prepare_objset(L=['EXTENSIONMARK']) ->
- L;
-prepare_objset(Set) when is_list(Set) ->
- {set,Set,false};
-prepare_objset({{'SingleValue',Set},Ext}) ->
- {set,merge_sets(Set,Ext),true};
-%%prepare_objset({Set,Ext}) when is_list(Set),is_list(Ext) ->
-%% {set,lists:append([Set,Ext]),true};
-prepare_objset({Set,Ext}) when is_list(Set) ->
- {set,merge_sets(Set,Ext),true};
-prepare_objset({{object,definedsyntax,_ObjFields}=Set,Ext}) ->
- {set,merge_sets(Set, Ext),true};
-prepare_objset(ObjDef={object,definedsyntax,_ObjFields}) ->
- {set,[ObjDef],false};
-prepare_objset({ObjDef=#type{},Ext}) when is_list(Ext) ->
- {set,[ObjDef|Ext],true};
-prepare_objset({#type{}=Type,#type{}=Ext}) ->
- {set,[Type,Ext],true};
-prepare_objset(Ret) ->
- Ret.
-
-class_fields_optional_check(S,#classdef{typespec=ClassSpec}) ->
- Fields = ClassSpec#objectclass.fields,
- class_fields_optional_check1(S,Fields).
-
-class_fields_optional_check1(_S,[]) ->
- ok;
-class_fields_optional_check1(S,[{typefield,_,'OPTIONAL'}|Rest]) ->
- class_fields_optional_check1(S,Rest);
-class_fields_optional_check1(S,[{fixedtypevaluefield,_,_,_,'OPTIONAL'}|Rest]) ->
- class_fields_optional_check1(S,Rest);
-class_fields_optional_check1(S,[{fixedtypevaluesetfield,_,_,'OPTIONAL'}|Rest]) ->
- class_fields_optional_check1(S,Rest);
-class_fields_optional_check1(S,[{objectfield,_,_,_,'OPTIONAL'}|Rest]) ->
- class_fields_optional_check1(S,Rest);
-class_fields_optional_check1(S,[{objectsetfield,_,_,'OPTIONAL'}|Rest]) ->
- class_fields_optional_check1(S,Rest).
-
-%% ObjectSetFromObjects functionality
-
-%% The fieldname is a list of field names.They may be objects or
-%% object sets. If ObjectSet is an object set the resulting object set
-%% is the union of object sets if the last field name is an object
-%% set. If the last field is an object the resulting object set is
-%% the set of objects in ObjectSet.
-object_set_from_objects(S,RefedObjMod,FieldName,ObjectSet) ->
- object_set_from_objects(S,RefedObjMod,FieldName,ObjectSet,[]).
-object_set_from_objects(S,RefedObjMod,FieldName,ObjectSet,InterSect)
- when is_record(ObjectSet,'ObjectSet') ->
- #'ObjectSet'{class=Cl,set=Set} = ObjectSet,
- {_,ClassDef} = get_referenced_type(S,Cl),
- object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,Set,InterSect,[]);
-object_set_from_objects(S,RefedObjMod,FieldName,Object,InterSect)
- when is_record(Object,'Object') ->
- #'Object'{classname=Cl,def=Def}=Object,
- object_set_from_objects(S,RefedObjMod,Cl,FieldName,[Def],InterSect,[]).
-object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,['EXTENSIONMARK'|Os],
- InterSect,Acc) ->
- object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,Os,InterSect,%%Acc);
- ['EXTENSIONMARK'|Acc]);
-object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,[O|Os],InterSect,Acc) ->
- case object_set_from_objects2(S,mod_of_obj(RefedObjMod,element(1,O)),
- ClassDef,FieldName,element(3,O),InterSect) of
- ObjS when is_list(ObjS) ->
- object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,Os,InterSect,ObjS++Acc);
- Obj ->
- object_set_from_objects(S,RefedObjMod,ClassDef,FieldName,Os,InterSect,[Obj|Acc])
- end;
-object_set_from_objects(_S,_RefedObjMod,_ClassDef,_FieldName,[],InterSect,Acc) ->
- %% For instance may Acc contain objects of same class from
- %% different object sets that in fact might be duplicates.
- remove_duplicate_objects(osfo_intersection(InterSect,Acc)).
-%% Acc.
-object_set_from_objects2(S,RefedObjMod,ClassDef,[{valuefieldreference,OName}],
- Fields,_InterSect) ->
- %% this is an object
- case lists:keysearch(OName,1,Fields) of
- {value,{_,TDef}} ->
- mk_object_set_from_object(S,RefedObjMod,TDef,ClassDef);
- _ ->
- [] % it may be an absent optional field
- end;
-object_set_from_objects2(S,RefedObjMod,ClassDef,[{typefieldreference,OSName}],
- Fields,_InterSect) ->
- %% this is an object set
- case lists:keysearch(OSName,1,Fields) of
- {value,{_,TDef}} ->
- case TDef#typedef.typespec of
- #'ObjectSet'{class=_NextClName,set=NextSet} ->%% = TDef#typedef.typespec,
- NextSet;
- #'Object'{def=_ObjDef} ->
- mk_object_set_from_object(S,RefedObjMod,TDef,ClassDef)
-%% ObjDef
- %% error({error,{internal,unexpected_object,TDef}})
- end;
- _ ->
- [] % it may be an absent optional field
- end;
-object_set_from_objects2(S,RefedObjMod,_ClassDef,[{valuefieldreference,OName}|Rest],
- Fields,InterSect) ->
- %% this is an object
- case lists:keysearch(OName,1,Fields) of
- {value,{_,TDef}} ->
- #'Object'{classname=NextClName,def=ODef}=TDef#typedef.typespec,
- {_,_,NextFields}=ODef,
- {_,NextClass} = get_referenced_type(S,NextClName),
- object_set_from_objects2(S,RefedObjMod,NextClass,Rest,NextFields,InterSect);
- _ ->
- []
- end;
-object_set_from_objects2(S,RefedObjMod,_ClassDef,[{typefieldreference,OSName}|Rest],
- Fields,InterSect) ->
- %% this is an object set
- Next = {NextClName,NextSet} =
- case lists:keysearch(OSName,1,Fields) of
- {value,{_,TDef}} when is_record(TDef,'ObjectSet') ->
- #'ObjectSet'{class=NextClN,set=NextS} = TDef,
- {NextClN,NextS};
- {value,{_,#typedef{typespec=OS}}} ->
- %% objectsets in defined syntax will come here as typedef{}
- %% #'ObjectSet'{class=NextClN,set=NextS} = OS,
- case OS of
- #'ObjectSet'{class=NextClN,set=NextS} ->
- {NextClN,NextS};
- #'Object'{classname=NextClN,def=NextDef} ->
- {NextClN,[NextDef]}
- end;
+ %% is parsed as a type.
+ case Class of
+ #type{def=#'Externaltypereference'{}=Def} ->
+ #'Object'{classname=Def,def=ObjectRef};
_ ->
- {[],[]}
- end,
- case Next of
- {[],[]} ->
- [];
- _ ->
- {_,NextClass} = get_referenced_type(S,NextClName),
- object_set_from_objects(S,RefedObjMod,NextClass,Rest,NextSet,InterSect,[])
- end.
-
-mk_object_set_from_object(S,RefedObjMod,TDef,Class) ->
- #'Object'{classname=_NextClName,def=ODef} = TDef#typedef.typespec,
- {_,_,NextFields}=ODef,
-
- UniqueFieldName =
- case (catch get_unique_fieldname(S,Class)) of
- {error,'__undefined_',_} -> {unique,undefined};
- {asn1,Msg,_} -> error({class,Msg,S});
- {'EXIT',Msg} -> error({class,{internal_error,Msg},S});
- {Other,_} -> Other
- end,
- VDef = get_unique_value(S,NextFields,UniqueFieldName),
- %% XXXXXXXXXXX
- case VDef of
- [] ->
- ['EXTENSIONMARK'];
- _ ->
- {{RefedObjMod,get_datastr_name(TDef)},VDef,NextFields}
+ asn1_error(S, illegal_object)
end.
-
-
-mod_of_obj(_RefedObjMod,{NewMod,ObjName})
- when is_atom(NewMod),is_atom(ObjName) ->
- NewMod;
-mod_of_obj(RefedObjMod,_) ->
- RefedObjMod.
-
-
-merge_sets(Root,{'SingleValue',Ext}) ->
- merge_sets(Root,Ext);
-merge_sets(Root,Ext) when is_list(Root),is_list(Ext) ->
- Root ++ Ext;
-merge_sets(Root,Ext) when is_list(Ext) ->
- [Root|Ext];
-merge_sets(Root,Ext) when is_list(Root) ->
- Root++[Ext];
-merge_sets(Root,Ext) ->
- [Root]++[Ext].
-
-reduce_objectset(ObjectSet,Exclusion) ->
- case Exclusion of
- {'SingleValue',#'Externalvaluereference'{value=Name}} ->
- case lists:keysearch(Name,1,ObjectSet) of
- {value,El} ->
- lists:subtract(ObjectSet,[El]);
- _ ->
- ObjectSet
- end
- end.
-
-%% Checks a list of objects or object sets and returns a list of selected
-%% information for the code generation.
-check_object_list(S,ClassRef,ObjectList) ->
- check_object_list(S,ClassRef,ObjectList,[]).
-
-check_object_list(S,ClassRef,[ObjOrSet|Objs],Acc) ->
- ?dbg("check_object_list: ~p~n",[ObjOrSet]),
- case ObjOrSet of
- ObjDef when is_tuple(ObjDef),(element(1,ObjDef)==object) ->
- Def =
- check_object(S,#typedef{typespec=ObjDef},
-% #'Object'{classname={objectclassname,ClassRef},
- #'Object'{classname=ClassRef,
- def=ObjDef}),
- check_object_list(S,ClassRef,Objs,[{{no_mod,no_name},Def#'Object'.def}|Acc]);
- {'SingleValue',Ref = #'Externalvaluereference'{}} ->
- ?dbg("{SingleValue,Externalvaluereference}~n",[]),
- {RefedMod,ObjName,
- #'Object'{def=Def}} = check_referenced_object(S,Ref),
- check_object_list(S,ClassRef,Objs,[{{RefedMod,ObjName},Def}|Acc]);
- ObjRef when is_record(ObjRef,'Externalvaluereference') ->
- ?dbg("Externalvaluereference~n",[]),
- {RefedMod,ObjName,
- #'Object'{def=Def}} = check_referenced_object(S,ObjRef),
- check_object_list(S,ClassRef,Objs,[{{RefedMod,ObjName},Def}|Acc]);
- {'ValueFromObject',{_,Object},FieldName} ->
- {_,Def} = get_referenced_type(S,Object),
- TypeDef = get_fieldname_element(S,Def,FieldName),
- (TypeDef#typedef.typespec)#'ObjectSet'.set;
- ObjSet when is_record(ObjSet,type) ->
- ObjSetDef =
- case ObjSet#type.def of
- Ref when is_record(Ref,'Externaltypereference') ->
- {_,D} = get_referenced_type(S,ObjSet#type.def),
- D;
- Other ->
- throw({asn1_error,{'unknown objecset',Other,S}})
- end,
- #'ObjectSet'{set=ObjectsInSet} =
- check_object(S,ObjSetDef,ObjSetDef#typedef.typespec),
- AccList = transform_set_to_object_list(ObjectsInSet,[]),
- check_object_list(S,ClassRef,Objs,AccList++Acc);
- union ->
- check_object_list(S,ClassRef,Objs,Acc);
- {pos,{objectset,_,DefinedObjectSet},Params} ->
- OSDef = #type{def={pt,DefinedObjectSet,Params}},
- #'ObjectSet'{set=Set} =
- check_object(S,ObjOrSet,#'ObjectSet'{class=ClassRef,
- set=OSDef}),
- check_object_list(S,ClassRef,Objs,Set ++ Acc);
- {pv,{simpledefinedvalue,DefinedObject},Params} ->
- Args = [match_parameters(S,Param,S#state.parameters)||
- Param<-Params],
- #'Object'{def=Def} =
- check_object(S,ObjOrSet,
- #'Object'{classname=ClassRef ,
- def={po,{object,DefinedObject},
- Args}}),
- check_object_list(S,ClassRef,Objs,[{{no_mod,no_name},Def}|Acc]);
- {'ObjectSetFromObjects',Os,FieldName} when is_tuple(Os) ->
- NewSet =
- check_ObjectSetFromObjects(S, element(tuple_size(Os), Os),
- FieldName,[]),
- check_object_list(S,ClassRef,Objs,NewSet++Acc);
- {{'ObjectSetFromObjects',Os,FieldName},InterSection}
- when is_tuple(Os) ->
- NewSet =
- check_ObjectSetFromObjects(S, element(tuple_size(Os), Os),
- FieldName,InterSection),
- check_object_list(S,ClassRef,Objs,NewSet++Acc);
- Other ->
- exit({error,{'unknown object',Other},S})
- end;
-%% Finally reverse the accumulated list and if there are any extension
-%% marks in the object set put one indicator of that in the end of the
-%% list.
-check_object_list(_,_,[],Acc) ->
- lists:reverse(Acc).
check_referenced_object(S,ObjRef)
when is_record(ObjRef,'Externalvaluereference')->
@@ -1213,195 +1002,134 @@ check_referenced_object(S,ObjRef)
check_object(update_state(S,RefedMod),ObjectDef,ObjectDef#typedef.typespec)}
end.
-check_ObjectSetFromObjects(S,ObjName,FieldName,InterSection) ->
- {RefedMod,TDef} = get_referenced_type(S,ObjName),
- ObjOrSet = check_object(update_state(S,RefedMod),TDef,TDef#typedef.typespec),
- InterSec = prepare_intersection(S,InterSection),
- _NewSet = object_set_from_objects(S,RefedMod,FieldName,ObjOrSet,InterSec).
+check_ObjectSetFromObjects(S, ObjName, Fields) ->
+ {_,Obj0} = get_referenced_type(S, ObjName),
+ case check_object(S, Obj0, Obj0#typedef.typespec) of
+ #'ObjectSet'{}=Obj1 ->
+ get_fieldname_set(S, Obj1, Fields);
+ #'Object'{classname=Class,
+ def={object,_,ObjFs}} ->
+ ObjSet = #'ObjectSet'{class=Class,
+ set=[{'_','_',ObjFs}]},
+ get_fieldname_set(S, ObjSet, Fields)
+ end.
-prepare_intersection(_S,[]) ->
- [];
-prepare_intersection(S,{'EXCEPT',ObjRef}) ->
- except_names(S,ObjRef);
-prepare_intersection(_S,T) ->
- exit({error,{internal_error,not_implemented,object_set_from_objects,T}}).
-except_names(_S,{'SingleValue',#'Externalvaluereference'{value=ObjName}}) ->
- [{except,ObjName}];
-except_names(_,T) ->
- exit({error,{internal_error,not_implemented,object_set_from_objects,T}}).
-
-osfo_intersection(InterSect,ObjList) ->
- Res = [X|| X = {{_,N},_,_} <- ObjList,
- lists:member({except,N},InterSect) == false],
- case lists:member('EXTENSIONMARK',ObjList) of
- true ->
- Res ++ ['EXTENSIONMARK'];
+%% get_type_from_object(State, ObjectOrObjectSet, [{RefType,FieldName}]) ->
+%% Type
+get_type_from_object(S, Object, FieldNames)
+ when is_record(Object, 'Externaltypereference');
+ is_record(Object, 'Externalvaluereference') ->
+ extract_field(S, Object, FieldNames).
+
+%% get_value_from_object(State, ObjectOrObjectSet, [{RefType,FieldName}]) ->
+%% UntaggedValue
+get_value_from_object(S, Def, FieldNames) ->
+ case extract_field(S, Def, FieldNames) of
+ #valuedef{value=Val} ->
+ Val;
+ {valueset,_}=Val ->
+ Val;
_ ->
- Res
+ asn1_error(S, illegal_value)
end.
-%% get_fieldname_element/3
-%% gets the type/value/object/... of the referenced element in FieldName
-%% FieldName is a list and may have more than one element.
-%% Each element in FieldName can be either {typefieldreference,AnyFieldName}
-%% or {valuefieldreference,AnyFieldName}
-%% Def is the def of the first object referenced by FieldName
-get_fieldname_element(S,Def,[{_RefType,FieldName}]) when is_record(Def,typedef) ->
- {_,_,ObjComps} = (Def#typedef.typespec)#'Object'.def,
- check_fieldname_element(S,lists:keysearch(FieldName,1,ObjComps));
-get_fieldname_element(S,Def,[{_RefType,FieldName}|Rest])
- when is_record(Def,typedef) ->
- %% As FieldName is followd by other FieldNames it has to be an
- %% object or objectset.
- {_,_,ObjComps} = (Def#typedef.typespec)#'Object'.def,
- NewDef = check_fieldname_element(S,lists:keysearch(FieldName,1,ObjComps)),
- ObjDef = fun(#'Object'{def=D}) -> D;
- (#'ObjectSet'{set=Set}) -> Set
- end
- (NewDef),
- case ObjDef of
+%% extract_field(State, ObjectOrObjectSet, [{RefType,FieldName}])
+%% RefType = typefieldreference | valuefieldreference
+%%
+%% Get the type, value, object, object set, or value set from the
+%% referenced object or object set. The list of field name tuples
+%% may have more than one element. All field names but the last
+%% refers to either an object or object set.
+
+extract_field(S, Def0, FieldNames) ->
+ {_,Def1} = get_referenced_type(S, Def0),
+ Def2 = check_object(S, Def1, Def1#typedef.typespec),
+ Def = Def1#typedef{typespec=Def2},
+ get_fieldname_element(S, Def, FieldNames).
+
+%% get_fieldname_element(State, Element, [{RefType,FieldName}]
+%% RefType = typefieldreference | valuefieldreference
+%%
+%% Get the type, value, object, object set, or value set from the referenced
+%% element. The list of field name tuples may have more than one element.
+%% All field names but the last refers to either an object or object set.
+
+get_fieldname_element(S, Object0, [{_RefType,FieldName}|Fields]) ->
+ Object = case Object0 of
+ #typedef{typespec=#'Object'{def=Obj}} -> Obj;
+ {_,_,_}=Obj -> Obj
+ end,
+ case check_fieldname_element(S, FieldName, Object) of
+ #'Object'{def=D} when Fields =/= [] ->
+ get_fieldname_element(S, D, Fields);
+ #'ObjectSet'{}=Set ->
+ get_fieldname_set(S, Set, Fields);
+ Result when Fields =:= [] ->
+ Result
+ end;
+get_fieldname_element(_S, Def, []) ->
+ Def.
+
+get_fieldname_set(S, #'ObjectSet'{set=Set0}, T) ->
+ get_fieldname_set_1(S, Set0, T, []).
+
+get_fieldname_set_1(S, ['EXTENSIONMARK'=Ext|T], Fields, Acc) ->
+ get_fieldname_set_1(S, T, Fields, [Ext|Acc]);
+get_fieldname_set_1(S, [H|T], Fields, Acc) ->
+ try get_fieldname_element(S, H, Fields) of
L when is_list(L) ->
- [get_fieldname_element(S,X,Rest) || X <- L];
- _ ->
- get_fieldname_element(S,ObjDef,Rest)
+ get_fieldname_set_1(S, T, Fields, L++Acc);
+ {valueset,L} ->
+ get_fieldname_set_1(S, T, Fields, L++Acc);
+ Other ->
+ get_fieldname_set_1(S, T, Fields, [Other|Acc])
+ catch
+ throw:{error,_} ->
+ get_fieldname_set_1(S, T, Fields, Acc)
end;
-get_fieldname_element(S,{object,_,Fields},[{_RefType,FieldName}|Rest]) ->
- NewDef = check_fieldname_element(S,lists:keysearch(FieldName,1,Fields)),
- get_fieldname_element(S,NewDef,Rest);
-get_fieldname_element(_S,Def,[]) ->
- Def;
-get_fieldname_element(_S,Def,[{_RefType,_FieldName}|_RestFName])
- when is_record(Def,typedef) ->
- ok.
+get_fieldname_set_1(_, [], _Fields, Acc) ->
+ case Acc of
+ [#valuedef{}|_] ->
+ {valueset,Acc};
+ _ ->
+ Acc
+ end.
-check_fieldname_element(S,{value,{_,Def}}) ->
- check_fieldname_element(S,Def);
-check_fieldname_element(S, #typedef{typespec=Ts}=TDef) ->
+check_fieldname_element(S, Name, {_,_,Fields}) ->
+ case lists:keyfind(Name, 1, Fields) of
+ {Name,Def} ->
+ check_fieldname_element_1(S, Def);
+ false ->
+ asn1_error(S, {undefined_field,Name})
+ end.
+
+check_fieldname_element_1(S, #typedef{typespec=Ts}=TDef) ->
case Ts of
#'Object'{} ->
check_object(S, TDef, Ts);
_ ->
check_type(S, TDef, Ts)
end;
-check_fieldname_element(S, #valuedef{}=VDef) ->
+check_fieldname_element_1(S, #valuedef{}=VDef) ->
try
check_value(S, VDef)
catch
- throw:{objectdef} ->
+ throw:{asn1_class, _} ->
#valuedef{checked=C,pos=Pos,name=N,type=Type,
value=Def} = VDef,
ClassName = Type#type.def,
NewSpec = #'Object'{classname=ClassName,def=Def},
NewDef = #typedef{checked=C,pos=Pos,name=N,typespec=NewSpec},
- check_fieldname_element(S, NewDef)
+ check_fieldname_element_1(S, NewDef)
end;
-check_fieldname_element(S,Eref)
- when is_record(Eref,'Externaltypereference');
- is_record(Eref,'Externalvaluereference') ->
- {_,TDef}=get_referenced_type(S,Eref),
- check_fieldname_element(S,TDef);
-check_fieldname_element(S,Other) ->
- throw({error,{assigned_object_error,"not_assigned_object",Other,S}}).
+check_fieldname_element_1(_S, {value_tag,Val}) ->
+ #valuedef{value=Val};
+check_fieldname_element_1(S, Eref)
+ when is_record(Eref, 'Externaltypereference');
+ is_record(Eref, 'Externalvaluereference') ->
+ {_,TDef} = get_referenced_type(S, Eref),
+ check_fieldname_element_1(S, TDef).
-transform_set_to_object_list([{Name,_UVal,Fields}|Objs],Acc) ->
- transform_set_to_object_list(Objs,[{Name,{object,generatesyntax,Fields}}|Acc]);
-transform_set_to_object_list(['EXTENSIONMARK'|Objs],Acc) ->
-%% transform_set_to_object_list(Objs,['EXTENSIONMARK'|Acc]);
- transform_set_to_object_list(Objs,Acc);
-transform_set_to_object_list([],Acc) ->
- Acc.
-
-get_unique_valuelist(_S,ObjSet,{unique,undefined}) -> % no unique field in object
- lists:map(fun({N,{_,_,F}})->{N,no_unique_value,F};
- (V={_,_,_}) ->V;
- ({A,B}) -> {A,no_unique_value,B}
- end, ObjSet);
-get_unique_valuelist(S,ObjSet,{UFN,Opt}) ->
- get_unique_vlist(S,ObjSet,UFN,Opt,[]).
-
-
-get_unique_vlist(_S,[],_,_,[]) ->
- ['EXTENSIONMARK'];
-get_unique_vlist(S,[],_,Opt,Acc) ->
- case catch check_uniqueness(remove_duplicate_objects(Acc)) of
- {asn1_error,_} when Opt =/= 'OPTIONAL' ->
- error({'ObjectSet',"not unique objects in object set",S});
- {asn1_error,_} ->
- lists:reverse(Acc);
- _ ->
- lists:reverse(Acc)
- end;
-get_unique_vlist(S,['EXTENSIONMARK'|Rest],UniqueFieldName,Opt,Acc) ->
- get_unique_vlist(S,Rest,UniqueFieldName,Opt,Acc);
-get_unique_vlist(S,[{ObjName,Obj}|Rest],UniqueFieldName,Opt,Acc) ->
- {_,_,Fields} = Obj,
- NewObjInf =
- case get_unique_value(S,Fields,UniqueFieldName) of
- #valuedef{value=V} -> [{ObjName,V,Fields}];
- [] -> []; % maybe the object only was a reference to an
- % empty object set.
- no_unique_value -> [{ObjName,no_unique_value,Fields}]
- end,
- get_unique_vlist(S,Rest,UniqueFieldName,Opt,NewObjInf++Acc);
-
-get_unique_vlist(S,[V={_,_,_}|Rest],UniqueFieldName,Opt,Acc) ->
- get_unique_vlist(S,Rest,UniqueFieldName,Opt,[V|Acc]).
-
-get_unique_value(S,Fields,UniqueFieldName) ->
- Module = S#state.mname,
- case lists:keysearch(UniqueFieldName,1,Fields) of
- {value,Field} ->
- case element(2,Field) of
- VDef when is_record(VDef,valuedef) ->
- VDef;
- {'ValueFromObject',Object,Name} ->
- case Object of
- {object,Ext} when is_record(Ext,'Externaltypereference') ->
- OtherModule = Ext#'Externaltypereference'.module,
- ExtObjName = Ext#'Externaltypereference'.type,
- ObjDef = asn1_db:dbget(OtherModule,ExtObjName),
- ObjSpec = ObjDef#typedef.typespec,
- get_unique_value(OtherModule,element(3,ObjSpec),Name);
- {object,{_,_,ObjName}} ->
- ObjDef = asn1_db:dbget(Module,ObjName),
- ObjSpec = ObjDef#typedef.typespec,
- get_unique_value(Module,element(3,ObjSpec),Name);
- {po,Object,_Params} ->
- exit({error,{'parameterized object not implemented yet',
- Object},S})
- end;
- Value when is_atom(Value);is_number(Value) ->
- #valuedef{value=Value,module=Module};
- {'CHOICE',{C,Value}} when is_atom(C) ->
- %% #valuedef{value=normalize_value(S,element(3,Field),VDef,[])}
- case Value of
- Scalar when is_atom(Scalar);is_number(Scalar) ->
- #valuedef{value=Value,module=Module};
- Eref = #'Externalvaluereference'{} ->
- element(2,get_referenced_type(S,Eref))
- end
- end;
- false ->
- case Fields of
- [{_,#typedef{typespec=#'ObjectSet'{set=['EXTENSIONMARK']}}}] ->
- [];
- _ ->
- no_unique_value
- end
- end.
-
-check_uniqueness(NameValueList) ->
- check_uniqueness1(lists:keysort(2,NameValueList)).
-
-check_uniqueness1([]) ->
- true;
-check_uniqueness1([_]) ->
- true;
-check_uniqueness1([{_,N,_},{_,N,_}|_Rest]) ->
- throw({asn1_error,{'objects in set must have unique values in UNIQUE fields',N}});
-check_uniqueness1([_|Rest]) ->
- check_uniqueness1(Rest).
-
%% instantiate_po/4
%% ClassDef is the class of Object,
%% Object is the Parameterized object, which is referenced,
@@ -1410,8 +1138,7 @@ check_uniqueness1([_|Rest]) ->
instantiate_po(S=#state{parameters=_OldArgs},_ClassDef,Object,ArgsList) when is_record(Object,pobjectdef) ->
FormalParams = get_pt_args(Object),
MatchedArgs = match_args(S,FormalParams,ArgsList,[]),
-% NewS = S#state{type=Object,parameters=MatchedArgs++OldArgs},
- NewS = S#state{type=Object,parameters=MatchedArgs},
+ NewS = S#state{parameters=MatchedArgs},
check_object(NewS,Object,#'Object'{classname=Object#pobjectdef.class,
def=Object#pobjectdef.def}).
@@ -1421,20 +1148,14 @@ instantiate_po(S=#state{parameters=_OldArgs},_ClassDef,Object,ArgsList) when is_
%% on the right side of the assignment,
%% ArgsList is the list of actual parameters, i.e. real objects
instantiate_pos(S=#state{parameters=_OldArgs},ClassRef,ObjectSetDef,ArgsList) ->
-% ClassName = ClassDef#classdef.name,
FormalParams = get_pt_args(ObjectSetDef),
OSet = case get_pt_spec(ObjectSetDef) of
- {valueset,Set} ->
-% #'ObjectSet'{class=name2Extref(S#state.mname,
-% ClassName),set=Set};
- #'ObjectSet'{class=ClassRef,set=Set};
- Set when is_record(Set,'ObjectSet') -> Set;
- _ ->
- error({type,"parameterized object set failure",S})
+ {valueset,Set} -> #'ObjectSet'{class=ClassRef,set=Set};
+ Set when is_record(Set,'ObjectSet') -> Set;
+ _ -> asn1_error(S, invalid_objectset)
end,
MatchedArgs = match_args(S,FormalParams,ArgsList,[]),
-% NewS = S#state{type=ObjectSetDef,parameters=MatchedArgs++OldArgs},
- NewS = S#state{type=ObjectSetDef,parameters=MatchedArgs},
+ NewS = S#state{parameters=MatchedArgs},
check_object(NewS,ObjectSetDef,OSet).
@@ -1468,7 +1189,7 @@ gen_incl1(S,Fields,[C|CFields]) ->
check_object(S,TDef,TDef#typedef.typespec);
ERef ->
{_,T} = get_referenced_type(S,ERef),
- check_object(S,T,object_to_check(T))
+ check_object(S, T, object_to_check(S, T))
end,
case gen_incl(S,ObjDef#'Object'.def,
ClassFields) of
@@ -1485,7 +1206,7 @@ gen_incl1(S,Fields,[C|CFields]) ->
end.
get_objclass_fields(S,Eref=#'Externaltypereference'{}) ->
- {_,ClassDef} = get_referenced_type(S,Eref),
+ {_,ClassDef} = get_referenced_type(S,Eref, true),
get_objclass_fields(S,ClassDef);
get_objclass_fields(S,CD=#classdef{typespec=#'Externaltypereference'{}}) ->
get_objclass_fields(S,CD#classdef.typespec);
@@ -1501,10 +1222,10 @@ gen_incl_set(S,Fields,#typedef{typespec=#type{def=Eref}})
{_,CDef} = get_referenced_type(S,Eref),
gen_incl_set(S,Fields,CDef);
gen_incl_set(S,Fields,ClassDef) ->
- case catch get_unique_fieldname(S,ClassDef) of
- Tuple when tuple_size(Tuple) =:= 3 ->
+ case get_unique_fieldname(S, ClassDef) of
+ no_unique ->
false;
- _ ->
+ {_, _} ->
gen_incl_set1(S,Fields,
(ClassDef#classdef.typespec)#objectclass.fields)
end.
@@ -1529,475 +1250,390 @@ gen_incl_set1(S,[Object|Rest],CFields)->
gen_incl_set1(S,Rest,CFields)
end.
-check_objectdefn(S,Def,CDef) when is_record(CDef,classdef) ->
- WithSyntax = (CDef#classdef.typespec)#objectclass.syntax,
- ClassFields = (CDef#classdef.typespec)#objectclass.fields,
+
+%%%
+%%% Check an object definition.
+%%%
+
+check_objectdefn(S, Def, #classdef{typespec=ObjClass}) ->
+ #objectclass{syntax=Syntax0,fields=ClassFields} = ObjClass,
case Def of
{object,defaultsyntax,Fields} ->
- check_defaultfields(S,Fields,ClassFields);
+ check_defaultfields(S, Fields, ClassFields);
{object,definedsyntax,Fields} ->
- {_,WSSpec} = WithSyntax,
- NewFields =
- case catch( convert_definedsyntax(S,Fields,WSSpec,
- ClassFields,[])) of
- {asn1,{_ErrorType,ObjToken,ClassToken}} ->
- throw({asn1,{'match error in object',ObjToken,
- 'found in object',ClassToken,'found in class'}});
- Err={asn1,_} -> throw(Err);
- Err={'EXIT',_} -> throw(Err);
- DefaultFields when is_list(DefaultFields) ->
- DefaultFields
- end,
- {object,defaultsyntax,NewFields};
- {object,_ObjectId} -> % This is a DefinedObject
- fixa;
- Other ->
- exit({error,{objectdefn,Other}})
+ Syntax = get_syntax(S, Syntax0, ClassFields),
+ case match_syntax(S, Syntax, Fields, []) of
+ {match,NewFields,[]} ->
+ {object,defaultsyntax,NewFields};
+ {match,_,[What|_]} ->
+ syntax_match_error(S, What);
+ {nomatch,[What|_]} ->
+ syntax_match_error(S, What);
+ {nomatch,[]} ->
+ syntax_match_error(S)
+ end
+ end.
+
+
+%%%
+%%% Pre-process the simplified syntax so that it can be more
+%%% easily matched.
+%%%
+
+get_syntax(_, {preprocessed_syntax,Syntax}, _) ->
+ Syntax;
+get_syntax(S, {'WITH SYNTAX',Syntax}, ClassFields) ->
+ preprocess_syntax(S, Syntax, ClassFields).
+
+preprocess_syntax(S, Syntax0, Cs) ->
+ Syntax = preprocess_syntax_1(S, Syntax0, Cs, true),
+ Present0 = preprocess_get_fields(Syntax, []),
+ Present1 = lists:sort(Present0),
+ Present = ordsets:from_list(Present1),
+ case Present =:= Present1 of
+ false ->
+ Dupl = Present1 -- Present,
+ asn1_error(S, {syntax_duplicated_fields,Dupl});
+ true ->
+ ok
+ end,
+ Mandatory0 = get_mandatory_class_fields(Cs),
+ Mandatory = ordsets:from_list(Mandatory0),
+ case ordsets:subtract(Mandatory, Present) of
+ [] ->
+ Syntax;
+ [_|_]=Missing ->
+ asn1_error(S, {syntax_missing_mandatory_fields,Missing})
end.
+preprocess_syntax_1(S, [H|T], Cs, Mandatory) when is_list(H) ->
+ [{optional,preprocess_syntax_1(S, H, Cs, false)}|
+ preprocess_syntax_1(S, T, Cs, Mandatory)];
+preprocess_syntax_1(S, [{valuefieldreference,Name}|T], Cs, Mandatory) ->
+ F = preprocess_check_field(S, Name, Cs, Mandatory),
+ [F|preprocess_syntax_1(S, T, Cs, Mandatory)];
+preprocess_syntax_1(S, [{typefieldreference,Name}|T], Cs, Mandatory) ->
+ F = preprocess_check_field(S, Name, Cs, Mandatory),
+ [F|preprocess_syntax_1(S, T, Cs, Mandatory)];
+preprocess_syntax_1(S,[{Token,_}|T], Cs, Mandatory) when is_atom(Token) ->
+ [{token,Token}|preprocess_syntax_1(S, T, Cs, Mandatory)];
+preprocess_syntax_1(S, [Token|T], Cs, Mandatory) when is_atom(Token) ->
+ [{token,Token}|preprocess_syntax_1(S, T, Cs, Mandatory)];
+preprocess_syntax_1(_, [], _, _) -> [].
+
+preprocess_check_field(S, Name, Cs, Mandatory) ->
+ case lists:keyfind(Name, 2, Cs) of
+ Tuple when is_tuple(Tuple) ->
+ case not Mandatory andalso is_mandatory_class_field(Tuple) of
+ true ->
+ asn1_error(S, {syntax_mandatory_in_optional_group,Name});
+ false ->
+ {field,Tuple}
+ end;
+ false ->
+ asn1_error(S, {syntax_undefined_field,Name})
+ end.
+
+preprocess_get_fields([{field,F}|T], Acc) ->
+ Name = element(2, F),
+ preprocess_get_fields(T, [Name|Acc]);
+preprocess_get_fields([{optional,L}|T], Acc) ->
+ preprocess_get_fields(T, preprocess_get_fields(L, Acc));
+preprocess_get_fields([_|T], Acc) ->
+ preprocess_get_fields(T, Acc);
+preprocess_get_fields([], Acc) ->
+ Acc.
+
+%%%
+%%% Match the actual fields in the object definition to
+%%% the pre-processed simplified syntax.
+%%%
+
+match_syntax(S, [{token,Token}|T], [A|As]=Args, Acc) ->
+ case A of
+ {word_or_setting,_,#'Externaltypereference'{type=Token}} ->
+ match_syntax(S, T, As, Acc);
+ {Token,Line} when is_integer(Line) ->
+ match_syntax(S, T, As, Acc);
+ _ ->
+ {nomatch,Args}
+ end;
+match_syntax(S, [{field,Field}|T]=Fs, [A|As0]=Args0, Acc) ->
+ try match_syntax_type(S, Field, A) of
+ {match,Match} ->
+ match_syntax(S, T, As0, lists:reverse(Match)++Acc);
+ {params,_Name,#ptypedef{args=Params}=P,Ref} ->
+ {Args,As} = lists:split(length(Params), As0),
+ Val = match_syntax_params(S, P, Ref, Args),
+ match_syntax(S, Fs, [Val|As], Acc)
+ catch
+ _:_ ->
+ {nomatch,Args0}
+ end;
+match_syntax(S, [{optional,L}|T], As0, Acc) ->
+ case match_syntax(S, L, As0, []) of
+ {match,Match,As} ->
+ match_syntax(S, T, As, lists:reverse(Match)++Acc);
+ {nomatch,As0} ->
+ match_syntax(S, T, As0, Acc);
+ {nomatch,_}=NoMatch ->
+ NoMatch
+ end;
+match_syntax(_, [_|_], [], _Acc) ->
+ {nomatch,[]};
+match_syntax(_, [], As, Acc) ->
+ {match,Acc,As}.
+
+match_syntax_type(S, Type, {value_tag,Val}) ->
+ match_syntax_type(S, Type, Val);
+match_syntax_type(S, Type, {setting,_,Val}) ->
+ match_syntax_type(S, Type, Val);
+match_syntax_type(S, Type, {word_or_setting,_,Val}) ->
+ match_syntax_type(S, Type, Val);
+match_syntax_type(_S, _Type, {Atom,Line})
+ when is_atom(Atom), is_integer(Line) ->
+ throw(nomatch);
+match_syntax_type(S, {fixedtypevaluefield,Name,#type{}=T,_,_}=Type,
+ #'Externalvaluereference'{}=ValRef0) ->
+ try get_referenced_type(S, ValRef0) of
+ {M,#valuedef{}=ValDef} ->
+ match_syntax_type(update_state(S, M), Type, ValDef)
+ catch
+ throw:{error,_} ->
+ ValRef = #valuedef{name=Name,
+ type=T,
+ value=ValRef0,
+ module=S#state.mname},
+ match_syntax_type(S, Type, ValRef)
+ end;
+match_syntax_type(S, {fixedtypevaluefield,Name,#type{},_,_}, #valuedef{}=Val0) ->
+ Val = check_value(S, Val0),
+ {match,[{Name,Val}]};
+match_syntax_type(S, {fixedtypevaluefield,Name,#type{},_,_},
+ {'ValueFromObject',{object,Object},FieldNames}) ->
+ Val = extract_field(S, Object, FieldNames),
+ {match,[{Name,Val}]};
+match_syntax_type(S, {fixedtypevaluefield,Name,#type{}=T,_,_}=Type, Any) ->
+ ValDef = #valuedef{name=Name,type=T,value=Any,module=S#state.mname},
+ match_syntax_type(S, Type, ValDef);
+match_syntax_type(_S, {fixedtypevaluesetfield,Name,#type{},_}, Any) ->
+ {match,[{Name,Any}]};
+match_syntax_type(S, {objectfield,Name,_,_,_}, #'Externalvaluereference'{}=Ref) ->
+ {M,Obj} = get_referenced_type(S, Ref),
+ check_object(S, Obj, object_to_check(S, Obj)),
+ {match,[{Name,Ref#'Externalvaluereference'{module=M}}]};
+match_syntax_type(S, {objectfield,Name,Class,_,_}, {object,_,_}=ObjDef) ->
+ InlinedObjName = list_to_atom(lists:concat([S#state.tname,
+ '_',Name])),
+ ObjSpec = #'Object'{classname=Class,def=ObjDef},
+ CheckedObj = check_object(S, #typedef{typespec=ObjSpec}, ObjSpec),
+ InlObj = #typedef{checked=true,name=InlinedObjName,typespec=CheckedObj},
+ ObjKey = {InlinedObjName, InlinedObjName},
+ insert_once(S, inlined_objects, ObjKey),
+ %% Which module to use here? Could it be other than top_module?
+ asn1_db:dbput(get(top_module), InlinedObjName, InlObj),
+ {match,[{Name,InlObj}]};
+match_syntax_type(_S, {objectfield,Name,_,_,_}, Any) ->
+ {match,[{Name,Any}]};
+match_syntax_type(S, {objectsetfield,Name,CDef0,_}, Any) ->
+ CDef = case CDef0 of
+ #type{def=CDef1} -> CDef1;
+ CDef1 -> CDef1
+ end,
+ case match_syntax_objset(S, Any, CDef) of
+ #typedef{typespec=#'ObjectSet'{}=Ts0}=Def ->
+ Ts = check_object(S, Def, Ts0),
+ {match,[{Name,Def#typedef{checked=true,typespec=Ts}}]};
+ _ ->
+ syntax_match_error(S, Any)
+ end;
+match_syntax_type(S, {typefield,Name0,_}, #type{def={pt,_,_}=Def}=Actual) ->
+ %% This is an inlined type. If constructed type, save in data base.
+ T = check_type(S, #typedef{typespec=Actual}, Actual),
+ #'Externaltypereference'{type=PtName} = element(2, Def),
+ NameList = [PtName,S#state.tname],
+ Name = list_to_atom(asn1ct_gen:list2name(NameList)),
+ NewTDef = #typedef{checked=true,name=Name,typespec=T},
+ asn1_db:dbput(S#state.mname, Name, NewTDef),
+ insert_once(S, parameterized_objects, {Name,type,NewTDef}),
+ {match,[{Name0,NewTDef}]};
+match_syntax_type(S, {typefield,Name,_}, #type{def=#'ObjectClassFieldType'{}}=Actual) ->
+ T = check_type(S, #typedef{typespec=Actual}, Actual),
+ {match,[{Name,ocft_def(T)}]};
+match_syntax_type(S, {typefield,Name,_}, #type{def=#'Externaltypereference'{}=Ref}) ->
+ match_syntax_external(S, Name, Ref);
+match_syntax_type(S, {typefield,Name,_}, #type{def=Def}=Actual) ->
+ T = check_type(S, #typedef{typespec=Actual}, Actual),
+ TypeName = asn1ct_gen:type(asn1ct_gen:get_inner(Def)),
+ {match,[{Name,#typedef{checked=true,name=TypeName,typespec=T}}]};
+match_syntax_type(S, {typefield,Name,_}, #'Externaltypereference'{}=Ref) ->
+ match_syntax_external(S, Name, Ref);
+match_syntax_type(_S, {variabletypevaluefield,Name,_,_}, Any) ->
+ {match,[{Name,Any}]};
+match_syntax_type(_S, {variabletypevaluesetfield,Name,_,_}, Any) ->
+ {match,[{Name,Any}]};
+match_syntax_type(_S, _Type, _Actual) ->
+ throw(nomatch).
+
+match_syntax_params(S0, #ptypedef{name=Name}=PtDef,
+ #'Externaltypereference'{module=M,type=N}=ERef0, Args) ->
+ S = S0#state{mname=M,module=load_asn1_module(S0, M),tname=Name},
+ Type = check_type(S, PtDef, #type{def={pt,ERef0,Args}}),
+ ERefName = new_reference_name(N),
+ ERef = #'Externaltypereference'{type=ERefName,module=S0#state.mname},
+ TDef = #typedef{checked=true,name=ERefName,typespec=Type},
+ insert_once(S0, parameterized_objects, {ERefName,type,TDef}),
+ asn1_db:dbput(S0#state.mname, ERef#'Externaltypereference'.type, TDef),
+ ERef.
+
+match_syntax_external(#state{mname=Mname}=S0, Name, Ref0) ->
+ {M,T0} = get_referenced_type(S0, Ref0),
+ Ref1 = Ref0#'Externaltypereference'{module=M},
+ case T0 of
+ #ptypedef{} ->
+ {params,Name,T0,Ref1};
+ #typedef{checked=false}=TDef0 when Mname =/= M ->
+ %% This typedef is an imported type (or maybe a set.asn
+ %% compilation).
+ S = S0#state{mname=M,module=load_asn1_module(S0, M),
+ tname=get_datastr_name(TDef0)},
+ Type = check_type(S, TDef0, TDef0#typedef.typespec),
+ TDef = TDef0#typedef{checked=true,typespec=Type},
+ asn1_db:dbput(M, get_datastr_name(TDef), TDef),
+ {match,[{Name,merged_name(S, Ref1)}]};
+ TDef ->
+ %% This might be a renamed type in a set of specs,
+ %% so rename the ref.
+ Type = asn1ct:get_name_of_def(TDef),
+ Ref = Ref1#'Externaltypereference'{type=Type},
+ {match,[{Name,Ref}]}
+ end.
+
+match_syntax_objset(_S, {element_set,_,_}=Set, ClassDef) ->
+ make_objset(ClassDef, Set);
+match_syntax_objset(S, #'Externaltypereference'{}=Ref, _) ->
+ {_,T} = get_referenced_type(S, Ref),
+ T;
+match_syntax_objset(S, #'Externalvaluereference'{}=Ref, _) ->
+ {_,T} = get_referenced_type(S, Ref),
+ T;
+match_syntax_objset(_, [_|_]=Set, ClassDef) ->
+ make_objset(ClassDef, Set);
+match_syntax_objset(S, {object,definedsyntax,Words}, ClassDef) ->
+ case Words of
+ [Word] ->
+ match_syntax_objset_1(S, Word, ClassDef);
+ [_|_] ->
+ %% More than one word does not make sense.
+ none
+ end;
+match_syntax_objset(S, #type{def=#'Externaltypereference'{}=Set}, ClassDef) ->
+ match_syntax_objset(S, Set, ClassDef);
+match_syntax_objset(_, #type{}, _) ->
+ none.
+
+match_syntax_objset_1(S, {setting,_,Set}, ClassDef) ->
+ %% Word that starts with an uppercase letter.
+ match_syntax_objset(S, Set, ClassDef);
+match_syntax_objset_1(S, {word_or_setting,_,Set}, ClassDef) ->
+ %% Word in uppercase/hyphens only.
+ match_syntax_objset(S, Set, ClassDef);
+match_syntax_objset_1(S, #type{def={'TypeFromObject', {object,Object}, FNs}},
+ ClassDef) ->
+ Set = extract_field(S, Object, FNs),
+ [_|_] = Set,
+ #typedef{checked=true,typespec=#'ObjectSet'{class=ClassDef,set=Set}};
+match_syntax_objset_1(_, #type{def=#'ObjectClassFieldType'{}}=Set, ClassDef) ->
+ make_objset(ClassDef, Set);
+match_syntax_objset_1(_, {object,_,_}=Object, ClassDef) ->
+ make_objset(ClassDef, [Object]).
+
+make_objset(ClassDef, Set) ->
+ #typedef{typespec=#'ObjectSet'{class=ClassDef,set=Set}}.
+
+syntax_match_error(S) ->
+ asn1_error(S, syntax_nomatch).
+
+syntax_match_error(S, What0) ->
+ What = printable_string(What0),
+ asn1_error(S, {syntax_nomatch,What}).
+
+printable_string(Def) ->
+ printable_string_1(Def).
+
+printable_string_1({word_or_setting,_,Def}) ->
+ printable_string_1(Def);
+printable_string_1({value_tag,V}) ->
+ printable_string_1(V);
+printable_string_1({#seqtag{val=Val1},Val2}) ->
+ atom_to_list(Val1) ++ " " ++ printable_string_1(Val2);
+printable_string_1(#type{def=Def}) ->
+ atom_to_list(asn1ct_gen:get_inner(Def));
+printable_string_1(#'Externaltypereference'{type=Type}) ->
+ atom_to_list(Type);
+printable_string_1(#'Externalvaluereference'{value=Type}) ->
+ atom_to_list(Type);
+printable_string_1({Atom,Line}) when is_atom(Atom), is_integer(Line) ->
+ q(Atom);
+printable_string_1({object,definedsyntax,L}) ->
+ q(string:join([printable_string_1(Item) || Item <- L], " "));
+printable_string_1([_|_]=Def) ->
+ case lists:all(fun is_integer/1, Def) of
+ true ->
+ lists:flatten(io_lib:format("~p", [Def]));
+ false ->
+ q(string:join([printable_string_1(Item) || Item <- Def], " "))
+ end;
+printable_string_1(Def) ->
+ lists:flatten(io_lib:format("~p", [Def])).
+
+q(S) ->
+ lists:concat(["\"",S,"\""]).
+
check_defaultfields(S, Fields, ClassFields) ->
Present = ordsets:from_list([F || {F,_} <- Fields]),
Mandatory0 = get_mandatory_class_fields(ClassFields),
Mandatory = ordsets:from_list(Mandatory0),
All = ordsets:from_list([element(2, F) || F <- ClassFields]),
- #state{type=T,tname=Obj} = S,
+ #state{tname=Obj} = S,
case ordsets:subtract(Present, All) of
[] ->
ok;
[_|_]=Invalid ->
- asn1_error(S, T, {invalid_fields,Invalid,Obj})
+ asn1_error(S, {invalid_fields,Invalid,Obj})
end,
case ordsets:subtract(Mandatory, Present) of
[] ->
check_defaultfields_1(S, Fields, ClassFields, []);
[_|_]=Missing ->
- asn1_error(S, T, {missing_mandatory_fields,Missing,Obj})
+ asn1_error(S, {missing_mandatory_fields,Missing,Obj})
end.
check_defaultfields_1(_S, [], _ClassFields, Acc) ->
{object,defaultsyntax,lists:reverse(Acc)};
check_defaultfields_1(S, [{FName,Spec}|Fields], ClassFields, Acc) ->
CField = lists:keyfind(FName, 2, ClassFields),
- {NewField,RestFields} =
- convert_to_defaultfield(S, FName, [Spec|Fields], CField),
- check_defaultfields_1(S, RestFields, ClassFields, [NewField|Acc]).
+ {match,Match} = match_syntax_type(S, CField, Spec),
+ check_defaultfields_1(S, Fields, ClassFields, Match++Acc).
-convert_definedsyntax(_S,[],[],_ClassFields,Acc) ->
- lists:reverse(Acc);
-convert_definedsyntax(S,Fields,WithSyntax,ClassFields,Acc) ->
- {MatchedField,RestFields,RestWS} =
- match_field(S,Fields,WithSyntax,ClassFields),
- if
- is_list(MatchedField) ->
- convert_definedsyntax(S,RestFields,RestWS,ClassFields,
- lists:append(MatchedField,Acc));
- true ->
- convert_definedsyntax(S,RestFields,RestWS,ClassFields,
- [MatchedField|Acc])
- end.
+get_mandatory_class_fields(ClassFields) ->
+ [element(2, F) || F <- ClassFields,
+ is_mandatory_class_field(F)].
-get_mandatory_class_fields([{fixedtypevaluefield,Name,_,_,'MANDATORY'}|T]) ->
- [Name|get_mandatory_class_fields(T)];
-get_mandatory_class_fields([{objectfield,Name,_,_,'MANDATORY'}|T]) ->
- [Name|get_mandatory_class_fields(T)];
-get_mandatory_class_fields([{objectsetfield,Name,_,'MANDATORY'}|T]) ->
- [Name|get_mandatory_class_fields(T)];
-get_mandatory_class_fields([{typefield,Name,'MANDATORY'}|T]) ->
- [Name|get_mandatory_class_fields(T)];
-get_mandatory_class_fields([{variabletypevaluefield,Name,_,'MANDATORY'}|T]) ->
- [Name|get_mandatory_class_fields(T)];
-get_mandatory_class_fields([{variabletypevaluesetfield,
- Name,_,'MANDATORY'}|T]) ->
- [Name|get_mandatory_class_fields(T)];
-get_mandatory_class_fields([_|T]) ->
- get_mandatory_class_fields(T);
-get_mandatory_class_fields([]) -> [].
-
-match_field(S,Fields,WithSyntax,ClassFields) ->
- match_field(S,Fields,WithSyntax,ClassFields,[]).
-
-match_field(S,Fields,[W|Ws],ClassFields,Acc) when is_list(W) ->
- case catch(match_optional_field(S,Fields,W,ClassFields,[])) of
- {'EXIT',_} ->
- match_field(Fields,Ws,ClassFields,Acc); %% add S
-%% {[Result],RestFields} ->
-%% {Result,RestFields,Ws};
- {Result,RestFields} when is_list(Result) ->
- {Result,RestFields,Ws};
- _ ->
- match_field(S,Fields,Ws,ClassFields,Acc)
- end;
-match_field(S,Fields,WithSyntax,ClassFields,_Acc) ->
- match_mandatory_field(S,Fields,WithSyntax,ClassFields,[]).
-
-match_optional_field(_S,RestFields,[],_,Ret) ->
- {Ret,RestFields};
-%% An additional optional field within an optional field
-match_optional_field(S,Fields,[W|Ws],ClassFields,Ret) when is_list(W) ->
- case catch match_optional_field(S,Fields,W,ClassFields,[]) of
- {'EXIT',_} when length(Ws) > 0 ->
- match_optional_field(S,Fields,Ws,ClassFields,Ret);
- {'EXIT',_} ->
- {Ret,Fields};
- {asn1,{optional_matcherror,_,_}} when length(Ws) > 0 ->
- match_optional_field(S,Fields,Ws,ClassFields,Ret);
- {asn1,{optional_matcherror,_,_}} ->
- {Ret,Fields};
- {OptionalField,RestFields} ->
- match_optional_field(S,RestFields,Ws,ClassFields,
- lists:append(OptionalField,Ret))
- end;
-%% identify and skip word
-match_optional_field(S,[{_,_,#'Externaltypereference'{type=WorS}}|Rest],
- [WorS|Ws],ClassFields,Ret) ->
- match_optional_field(S,Rest,Ws,ClassFields,Ret);
-match_optional_field(S,[],_,ClassFields,Ret) ->
- match_optional_field(S,[],[],ClassFields,Ret);
-%% identify and skip comma
-match_optional_field(S,[{WorS,_}|Rest],[{WorS,_}|Ws],ClassFields,Ret) ->
- match_optional_field(S,Rest,Ws,ClassFields,Ret);
-%% am optional setting inside another optional setting may be "double-listed"
-match_optional_field(S,[Setting],DefinedSyntax,ClassFields,Ret)
- when is_list(Setting) ->
- match_optional_field(S,Setting,DefinedSyntax,ClassFields,Ret);
-%% identify and save field data
-match_optional_field(S,[Setting|Rest],[{_,W}|Ws],ClassFields,Ret) ->
- ?dbg("matching optional field setting: ~p with user friendly syntax: ~p~n",[Setting,W]),
- WorS =
- case Setting of
- Type when is_record(Type,type) -> Type;
- {'ValueFromObject',_,_} -> Setting;
- {object,_,_} -> Setting;
- {_,_,WordOrSetting} -> WordOrSetting;
- Other -> Other
- end,
- case lists:keysearch(W,2,ClassFields) of
- false ->
- throw({asn1,{optional_matcherror,WorS,W}});
- {value,CField} ->
- {NewField,RestFields} =
- convert_to_defaultfield(S,W,[WorS|Rest],CField),
- match_optional_field(S,RestFields,Ws,ClassFields,[NewField|Ret])
- end;
-match_optional_field(_S,[WorS|_Rest],[W|_Ws],_ClassFields,_Ret) ->
- throw({asn1,{optional_matcherror,WorS,W}}).
-
-match_mandatory_field(_S,[],[],_,[Acc]) ->
- {Acc,[],[]};
-match_mandatory_field(_S,[],[],_,Acc) ->
- {Acc,[],[]};
-match_mandatory_field(S,[],[H|T],CF,Acc) when is_list(H) ->
- match_mandatory_field(S,[],T,CF,Acc);
-match_mandatory_field(_S,[],WithSyntax,_,_Acc) ->
- throw({asn1,{mandatory_matcherror,[],WithSyntax}});
-%match_mandatory_field(_S,Fields,WithSyntax=[W|_Ws],_ClassFields,[Acc]) when is_list(W) ->
-match_mandatory_field(_S,Fields,WithSyntax=[W|_Ws],_ClassFields,Acc) when is_list(W), length(Acc) >= 1 ->
- {Acc,Fields,WithSyntax};
-%% identify and skip word
-%%match_mandatory_field(S,[{_,_,WorS}|Rest],
-match_mandatory_field(S,[{_,_,#'Externaltypereference'{type=WorS}}|Rest],
- [WorS|Ws],ClassFields,Acc) ->
- match_mandatory_field(S,Rest,Ws,ClassFields,Acc);
-%% identify and skip comma
-match_mandatory_field(S,[{WorS,_}|Rest],[{WorS,_}|Ws],ClassFields,Ret) ->
- match_mandatory_field(S,Rest,Ws,ClassFields,Ret);
-%% identify and save field data
-match_mandatory_field(S,[Setting|Rest],[{_,W}|Ws],ClassFields,Acc) ->
- ?dbg("matching field setting: ~p with user friendly syntax: ~p~n",[Setting,W]),
- WorS =
- case Setting of
- {object,_,_} -> Setting;
- {_,_,WordOrSetting} -> WordOrSetting;
- Type when is_record(Type,type) -> Type;
- Other -> Other
- end,
- case lists:keysearch(W,2,ClassFields) of
- false ->
- throw({asn1,{mandatory_matcherror,WorS,W}});
- {value,CField} ->
- {NewField,RestFields} =
- convert_to_defaultfield(S,W,[WorS|Rest],CField),
- match_mandatory_field(S,RestFields,Ws,ClassFields,[NewField|Acc])
- end;
-
-match_mandatory_field(_S,[WorS|_Rest],[W|_Ws],_ClassFields,_Acc) ->
- throw({asn1,{mandatory_matcherror,WorS,W}}).
-
-%% Converts a field of an object from defined syntax to default syntax
-%% A field may be a type, a fixed type value, an object, an objectset,
-%%
-convert_to_defaultfield(S,ObjFieldName,[OFS|RestOFS],CField)->
- ?dbg("convert field: ~p of type: ~p~n",[ObjFieldName,element(1,CField)]),
- CurrMod = S#state.mname,
- Strip_value_tag =
- fun({value_tag,ValueSetting}) -> ValueSetting;
- (VS) -> VS
- end,
- ObjFieldSetting = Strip_value_tag(OFS),
- RestSettings = [Strip_value_tag(X)||X <- RestOFS],
- case element(1,CField) of
- typefield ->
- TypeDef=
- case ObjFieldSetting of
- TypeRec when is_record(TypeRec,type) -> TypeRec#type.def;
- TDef when is_record(TDef,typedef) ->
- TDef#typedef{checked=true,
- typespec=check_type(S,TDef,
- TDef#typedef.typespec)};
- _ -> ObjFieldSetting
- end,
- {Type,SettingsLeft} =
- if
- is_record(TypeDef,typedef) -> {TypeDef,RestSettings};
- is_record(TypeDef,'ObjectClassFieldType') ->
- T=check_type(S,#typedef{typespec=ObjFieldSetting},ObjFieldSetting),
- {oCFT_def(S,T),RestSettings};
-% #typedef{checked=true,name=Name,typespec=IT};
- is_tuple(TypeDef), element(1,TypeDef) == pt ->
- %% this is an inlined type. If constructed
- %% type save in data base
- T=check_type(S,#typedef{typespec=ObjFieldSetting},ObjFieldSetting),
- #'Externaltypereference'{type=PtName} =
- element(2,TypeDef),
- NameList = [PtName,S#state.tname],
- NewName = list_to_atom(asn1ct_gen:list2name(NameList)),
- NewTDef=#typedef{checked=true,name=NewName,
- typespec=T},
- asn1_db:dbput(S#state.mname,NewName,NewTDef),
- %%asn1ct_gen:insert_once(parameterized_objects,{NewName,type,NewTDef}),
- insert_once(S,parameterized_objects,
- {NewName,type,NewTDef}),
- {NewTDef,RestSettings};
- is_tuple(TypeDef), element(1,TypeDef)=='SelectionType' ->
- T=check_type(S,#typedef{typespec=ObjFieldSetting},
- ObjFieldSetting),
- Name = type_name(S,T),
- {#typedef{checked=true,name=Name,typespec=T},RestSettings};
- true ->
- case asn1ct_gen:type(asn1ct_gen:get_inner(TypeDef)) of
- ERef = #'Externaltypereference'{module=CurrMod} ->
- {RefMod,T} = get_referenced_type(S,ERef),
- check_and_save(S,ERef#'Externaltypereference'{module=RefMod},T,RestSettings);
-
- ERef = #'Externaltypereference'{} ->
- {RefMod,T} = get_referenced_type(S,ERef),
- check_and_save(S,ERef#'Externaltypereference'{module=RefMod},T,RestSettings);
- Bif when Bif=={primitive,bif};Bif=={constructed,bif} ->
- T = check_type(S,#typedef{typespec=ObjFieldSetting},
- ObjFieldSetting),
- {#typedef{checked=true,name=Bif,typespec=T},RestSettings};
- _ ->
- %this case should not happen any more
- {Mod,T} =
- get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=ObjFieldSetting}),
- case Mod of
- CurrMod ->
- {T,RestSettings};
- ExtMod ->
- #typedef{name=Name} = T,
- {T#typedef{name={ExtMod,Name}},RestSettings}
- end
- end
- end,
- {{ObjFieldName,Type},SettingsLeft};
- fixedtypevaluefield ->
- case ObjFieldName of
- Val when is_atom(Val) ->
- %% ObjFieldSetting can be a value,an objectidentifiervalue,
- %% an element in an enumeration or namednumberlist etc.
- ValRef =
- case ObjFieldSetting of
- ValSetting=#'Externalvaluereference'{} ->
- ValSetting;
- {'ValueFromObject',{_,ObjRef},FieldName} ->
- {_,Object} = get_referenced_type(S,ObjRef),
- ChObject = check_object(S,Object,
- Object#typedef.typespec),
- get_fieldname_element(S,Object#typedef{typespec=ChObject},
- FieldName);
- ValSetting = #valuedef{} ->
- ValSetting;
- ValSetting ->
- #valuedef{type=element(3,CField),
- value=ValSetting,
- module=S#state.mname}
- end,
- ?dbg("fixedtypevaluefield ValRef: ~p~n",[ValRef]),
- case ValRef of
- #valuedef{} ->
- {{ObjFieldName,check_value(S,ValRef)},RestSettings};
- _ ->
- ValDef =
- case catch get_referenced_type(S,ValRef) of
- {error,_} ->
- NewValDef =
- #valuedef{name=Val,
- type=element(3,CField),
- value=ObjFieldSetting,
- module=S#state.mname},
- check_value(S,NewValDef);
- {M,VDef} when is_record(VDef,valuedef) ->
- check_value(update_state(S,M),
- %%S#state{mname=M},
- VDef);%% XXX
- {M,VDef} ->
- check_value(update_state(S,M),
- %%S#state{mname=M},
- #valuedef{name=Val,
- type=element(3,CField),
- value=VDef,
- module=M})
- end,
- {{ObjFieldName,ValDef},RestSettings}
- end;
- Val ->
- {{ObjFieldName,Val},RestSettings}
- end;
- fixedtypevaluesetfield ->
- {{ObjFieldName,ObjFieldSetting},RestSettings};
- objectfield ->
- CheckObject =
- fun(O) ->
- O#typedef{checked=true,typespec=
- check_object(S,O,O#typedef.typespec)}
- end,
- ObjectSpec =
- case ObjFieldSetting of
- Ref when is_record(Ref,'Externalvaluereference') ->
- %% The object O might be a #valuedef{} if
- %% e.g. the definition looks like
- %% myobj SOMECLASS ::= referencedObject
- {M,O} = get_referenced_type(S,Ref),
- check_object(S,O,object_to_check(O)),
- Ref#'Externalvaluereference'{module=M};
-
- {'ValueFromObject',{_,ObjRef},FieldName} ->
- %% This is an ObjectFromObject
- {_,Object} = get_referenced_type(S,ObjRef),
- ChObject = check_object(S,Object,
- Object#typedef.typespec),
- ObjFromObj=
- get_fieldname_element(S,Object#typedef{
- typespec=ChObject},
- FieldName),
- CheckObject(ObjFromObj);
- ObjDef={object,_,_} ->
- %% An object defined inlined in another object
- %% class is an objectfield, that implies that
- %% {objectsetfield,TypeFieldName,DefinedObjecClass,
- %% OptionalitySpec}
- %% DefinedObjecClass = #'Externaltypereference'{}|
- %% 'TYPE-IDENTIFIER' | 'ABSTRACT-SYNTAX'
- ClassName = element(3,CField),
- InlinedObjName=
- list_to_atom(lists:concat([S#state.tname]++
- ['_',ObjFieldName])),
-
- ObjSpec = #'Object'{classname=ClassName,
- def=ObjDef},
- CheckedObj=
- check_object(S,#typedef{typespec=ObjSpec},ObjSpec),
- InlObj = #typedef{checked=true,name=InlinedObjName,
- typespec=CheckedObj},
- ObjKey = {InlinedObjName,InlinedObjName},
- %% asn1ct_gen:insert_once(inlined_objects,ObjKey),
- insert_once(S,inlined_objects,ObjKey),
- %% Which module to use here? Could it be other than top_module ?
- %% asn1_db:dbput(S#state.mname,InlinedObjName,InlObj),
- asn1_db:dbput(get(top_module),InlinedObjName,InlObj),
- InlObj;
- #type{def=Eref} when is_record(Eref,'Externaltypereference') ->
- {_,O} = get_referenced_type(S,Eref),
- CheckObject(O);
- Other ->
- {_,O} = get_referenced_type(S,#'Externaltypereference'{module=S#state.mname,type=Other}),
- CheckObject(O)
- end,
- {{ObjFieldName,ObjectSpec},RestSettings};
- variabletypevaluefield ->
- {{ObjFieldName,ObjFieldSetting},RestSettings};
- variabletypevaluesetfield ->
- {{ObjFieldName,ObjFieldSetting},RestSettings};
-%% objectset_or_fixedtypevalueset_field ->
-%% ok;
- objectsetfield ->
- ObjSetSpec = get_objectset_def(S,ObjFieldSetting,CField),
- ?dbg("objectsetfield, ObjSetSpec:~p~n",[ObjSetSpec]),
- {{ObjFieldName,
- ObjSetSpec#typedef{checked=true,
- typespec=check_object(S,ObjSetSpec,
- ObjSetSpec#typedef.typespec)}},RestSettings}
- end.
-
-get_objectset_def(S,Ref,CField)
- when is_record(Ref,'Externaltypereference');
- is_record(Ref,'Externalvaluereference') ->
- {_M,T}=get_referenced_type(S,Ref),
- get_objectset_def2(S,T,CField);
-get_objectset_def(S,ObjectList,CField) when is_list(ObjectList) ->
- %% an objctset defined in the object,though maybe
- %% parsed as a SequenceOfValue
- %% The ObjectList may be a list of references to
- %% objects, a ValueFromObject
- ?dbg("objectsetfield: ~p~n",[CField]),
- get_objectset_def2(S,ObjectList,CField);
-get_objectset_def(S,'EXTENSIONMARK',CField) ->
- ?dbg("objectsetfield: ~p~n",[CField]),
- get_objectset_def2(S,['EXTENSIONMARK'],CField);
-get_objectset_def(_S,ObjFieldSetting={'SingleValue',_},CField) ->
- %% a Union of defined objects
- ?dbg("objectsetfield, SingleValue~n",[]),
- union_of_defed_objs(CField,ObjFieldSetting);
-get_objectset_def(_S,ObjFieldSetting={{'SingleValue',_},_},CField) ->
- %% a Union of defined objects
- ?dbg("objectsetfield, SingleValue~n",[]),
- union_of_defed_objs(CField,ObjFieldSetting);
-get_objectset_def(S,{object,_,[#type{def={'TypeFromObject',
- {object,RefedObj},
- FieldName}}]},_CField) ->
- %% This case occurs when an ObjectSetFromObjects
- %% production is used
- {_M,Def} = get_referenced_type(S,RefedObj),
- get_fieldname_element(S,Def,FieldName);
-get_objectset_def(S,{object,_,[{setting,_,ERef}]},CField)
- when is_record(ERef,'Externaltypereference') ->
- {_,T} = get_referenced_type(S,ERef),
- get_objectset_def2(S,T,CField);
-get_objectset_def(S,#type{def=ERef},_CField)
- when is_record(ERef,'Externaltypereference') ->
- {_,T} = get_referenced_type(S,ERef),
- T;
-get_objectset_def(S,ObjFieldSetting,CField)
- when is_atom(ObjFieldSetting) ->
- ERef = #'Externaltypereference'{module=S#state.mname,
- type=ObjFieldSetting},
- {_,T} = get_referenced_type(S,ERef),
- get_objectset_def2(S,T,CField).
-
-get_objectset_def2(_S,T = #typedef{typespec=#'Object'{}},_CField) ->
- #typedef{typespec=#'Object'{classname=Class,def=Def}} = T,
- T#typedef{typespec=#'ObjectSet'{class=Class,set=[Def]}};
-get_objectset_def2(_S,Set,CField) when is_list(Set) ->
- {_,_,Type,_} = CField,
- ClassDef = Type#type.def,
- #typedef{typespec=#'ObjectSet'{class=ClassDef,
- set=Set}};
-get_objectset_def2(_S,T = #typedef{typespec=#'ObjectSet'{}},_CField) ->
- T;
-get_objectset_def2(S,T,_CField) ->
- asn1ct:warning("get_objectset_def2: uncontrolled object set structure:~n~p~n",
- [T],S,"get_objectset_def2: uncontrolled object set structure").
-
-type_name(S,#type{def=Def}) ->
- CurrMod = S#state.mname,
- case asn1ct_gen:type(asn1ct_gen:get_inner(Def)) of
- #'Externaltypereference'{module=CurrMod,type=Name} ->
- Name;
- #'Externaltypereference'{module=Mod,type=Name} ->
- {Mod,Name};
- Bif when Bif=={primitive,bif};Bif=={constructed,bif} ->
- Bif
- end.
+is_mandatory_class_field({fixedtypevaluefield,_,_,_,'MANDATORY'}) ->
+ true;
+is_mandatory_class_field({objectfield,_,_,_,'MANDATORY'}) ->
+ true;
+is_mandatory_class_field({objectsetfield,_,_,'MANDATORY'}) ->
+ true;
+is_mandatory_class_field({typefield,_,'MANDATORY'}) ->
+ true;
+is_mandatory_class_field({variabletypevaluefield,_,_,'MANDATORY'}) ->
+ true;
+is_mandatory_class_field({variabletypevaluesetfield,_,_,'MANDATORY'}) ->
+ true;
+is_mandatory_class_field(_) ->
+ false.
merged_name(#state{inputmodules=[]},ERef) ->
ERef;
@@ -2013,38 +1649,18 @@ merged_name(S,ERef=#'Externaltypereference'{module=M}) ->
ERef
end.
-oCFT_def(S,T) ->
- case get_OCFT_inner(S,T) of
- ERef=#'Externaltypereference'{} -> ERef;
- {Name,Type} -> #typedef{checked=true,name=Name,typespec=Type};
- 'ASN1_OPEN_TYPE' ->
- #typedef{checked=true,typespec=T#type{def='ASN1_OPEN_TYPE'}}
- end.
-
-get_OCFT_inner(_S,T) ->
-% Module=S#state.mname,
- Def = T#type.def,
- case Def#'ObjectClassFieldType'.type of
+ocft_def(#type{def=#'ObjectClassFieldType'{type=OCFT}}=T) ->
+ case OCFT of
{fixedtypevaluefield,_,InnerType} ->
case asn1ct_gen:type(asn1ct_gen:get_inner(InnerType#type.def)) of
- Bif when Bif=={primitive,bif};Bif=={constructed,bif} ->
- {Bif,InnerType};
- ERef = #'Externaltypereference'{} ->
- ERef
+ Bif when Bif =:= {primitive,bif}; Bif =:= {constructed,bif} ->
+ #typedef{checked=true,name=Bif,typespec=InnerType};
+ #'Externaltypereference'{}=Ref ->
+ Ref
end;
- 'ASN1_OPEN_TYPE' -> 'ASN1_OPEN_TYPE'
+ 'ASN1_OPEN_TYPE' ->
+ #typedef{checked=true,typespec=T#type{def='ASN1_OPEN_TYPE'}}
end.
-
-
-
-union_of_defed_objs({_,_,_ObjClass=#type{def=ClassDef},_},ObjFieldSetting) ->
- #typedef{typespec=#'ObjectSet'{class = ClassDef,
- set = ObjFieldSetting}};
-union_of_defed_objs({_,_,DefObjClassRef,_},ObjFieldSetting)
- when is_record(DefObjClassRef,'Externaltypereference') ->
- #typedef{typespec=#'ObjectSet'{class = DefObjClassRef,
- set = ObjFieldSetting}}.
-
check_value(OldS,V) when is_record(V,pvaluesetdef) ->
#pvaluesetdef{checked=Checked,type=Type} = V,
@@ -2068,8 +1684,7 @@ check_value(OldS,V) when is_record(V,typedef) ->
#typedef{typespec=TS} = V,
case TS of
#'ObjectSet'{class=ClassRef} ->
- {RefM,TSDef} = get_referenced_type(OldS,ClassRef),
- %%IsObjectSet(TSDef);
+ {_RefM,TSDef} = get_referenced_type(OldS, ClassRef),
case TSDef of
#classdef{} -> throw({objectsetdef});
#typedef{typespec=#type{def=Eref}} when
@@ -2077,14 +1692,12 @@ check_value(OldS,V) when is_record(V,typedef) ->
%% This case if the class reference is a defined
%% reference to class
check_value(OldS,V#typedef{typespec=TS#'ObjectSet'{class=Eref}});
- #typedef{} ->
+ #typedef{typespec=HostType} ->
% an ordinary value set with a type in #typedef.typespec
- ValueSet = TS#'ObjectSet'.set,
- Type=check_type(OldS,TSDef,TSDef#typedef.typespec),
- Value = check_value(OldS,#valuedef{type=Type,
- value=ValueSet,
- module=RefM}),
- {valueset,Type#type{constraint=Value#valuedef.value}}
+ ValueSet0 = TS#'ObjectSet'.set,
+ Constr = check_constraints(OldS, HostType, [ValueSet0]),
+ Type = check_type(OldS,TSDef,TSDef#typedef.typespec),
+ {valueset,Type#type{constraint=Constr}}
end;
_ ->
throw({objectsetdef})
@@ -2104,11 +1717,11 @@ check_value(S, #valuedef{}=V) ->
end.
check_valuedef(#state{recordtopname=TopName}=S0, V0) ->
- #valuedef{name=Name,type=Vtype,value=Value,module=ModName} = V0,
+ #valuedef{name=Name,type=Vtype0,value=Value,module=ModName} = V0,
V = V0#valuedef{checked=true},
+ Vtype = check_type(S0, #typedef{name=Name,typespec=Vtype0},Vtype0),
Def = Vtype#type.def,
- Constr = Vtype#type.constraint,
- S1 = S0#state{type=Vtype,tname=Def,value=V0,vname=Name},
+ S1 = S0#state{tname=Def},
SVal = update_state(S1, ModName),
case Def of
#'Externaltypereference'{type=RecName}=Ext ->
@@ -2116,9 +1729,8 @@ check_valuedef(#state{recordtopname=TopName}=S0, V0) ->
%% If V isn't a value but an object Type is a #classdef{}
S2 = update_state(S1, RefM),
case Type of
- #classdef{} ->
- throw({objectdef});
- #typedef{typespec=TypeSpec} ->
+ #typedef{typespec=TypeSpec0}=TypeDef ->
+ TypeSpec = check_type(S2, TypeDef, TypeSpec0),
S3 = case is_contextswitchtype(Type) of
true ->
S2;
@@ -2135,7 +1747,7 @@ check_valuedef(#state{recordtopname=TopName}=S0, V0) ->
V#valuedef{type=Type}),
V#valuedef{value=CheckedVal}
end;
- 'ANY' ->
+ 'ASN1_OPEN_TYPE' ->
{opentypefieldvalue,ANYType,ANYValue} = Value,
CheckedV = check_value(SVal,#valuedef{name=Name,
type=ANYType,
@@ -2143,19 +1755,12 @@ check_valuedef(#state{recordtopname=TopName}=S0, V0) ->
module=ModName}),
V#valuedef{value=CheckedV#valuedef.value};
'INTEGER' ->
- ok = validate_integer(SVal, Value, [], Constr),
V#valuedef{value=normalize_value(SVal, Vtype, Value, [])};
- {'INTEGER',NamedNumberList} ->
- ok = validate_integer(SVal, Value, NamedNumberList, Constr),
+ {'INTEGER',_NamedNumberList} ->
V#valuedef{value=normalize_value(SVal, Vtype, Value, [])};
#'SEQUENCE'{} ->
- {ok,SeqVal} = convert_external(SVal, Value),
+ {ok,SeqVal} = convert_external(SVal, Vtype, Value),
V#valuedef{value=normalize_value(SVal, Vtype, SeqVal, TopName)};
- {'SelectionType',SelName,SelT} ->
- CheckedT = check_selectiontype(SVal, SelName, SelT),
- NewV = V#valuedef{type=CheckedT},
- SelVDef = check_value(S1#state{value=NewV}, NewV),
- V#valuedef{value=SelVDef#valuedef.value};
_ ->
V#valuedef{value=normalize_value(SVal, Vtype, Value, TopName)}
end.
@@ -2169,179 +1774,97 @@ is_contextswitchtype(#typedef{name='CHARACTER STRING'}) ->
is_contextswitchtype(_) ->
false.
-% validate_integer(S,{identifier,Pos,Id},NamedNumberList,Constr) ->
-% case lists:keysearch(Id,1,NamedNumberList) of
-% {value,_} -> ok;
-% false -> error({value,"unknown NamedNumber",S})
-% end;
-%% This case occurs when there is a valuereference
-%% validate_integer(S=#state{mname=M},
-%% #'Externalvaluereference'{module=M,value=Id}=Ref,
-validate_integer(S,#'Externalvaluereference'{value=Id}=Ref,
- NamedNumberList,Constr) ->
- case lists:keysearch(Id,1,NamedNumberList) of
- {value,_} -> ok;
- false -> validate_integer_ref(S,Ref,NamedNumberList,Constr)
- %%error({value,"unknown NamedNumber",S})
- end;
-validate_integer(S,Id,NamedNumberList,Constr) when is_atom(Id) ->
- case lists:keysearch(Id,1,NamedNumberList) of
- {value,_} -> ok;
- false -> validate_integer_ref(S,Id,NamedNumberList,Constr)
- %error({value,"unknown NamedNumber",S})
+%%%
+%%% Start of OBJECT IDENTFIER/RELATIVE-OID validation.
+%%%
+
+validate_objectidentifier(S, OidType, #'Externalvaluereference'{}=Id) ->
+ %% Must be an OBJECT IDENTIFIER or RELATIVE-OID depending on OidType.
+ get_oid_value(S, OidType, false, Id);
+validate_objectidentifier(S, OidType, {'ValueFromObject',{object,Obj},Fields}) ->
+ %% Must be an OBJECT IDENTIFIER/RELATIVE-OID depending on OidType.
+ case extract_field(S, Obj, Fields) of
+ #valuedef{checked=true,value=Value,type=Type} when is_tuple(Value) ->
+ _ = get_oid_type(S, OidType, Type),
+ Value;
+ _ ->
+ asn1_error(S, {illegal_oid,OidType})
end;
-validate_integer(_S,Value,_NamedNumberList,Constr) when is_integer(Value) ->
- check_integer_range(Value,Constr).
-
-validate_integer_ref(S,Id,_,_) when is_atom(Id) ->
- error({value,"unknown integer referens",S});
-validate_integer_ref(S,Ref,NamedNumberList,Constr) ->
- case get_referenced_type(S,Ref) of
- {M,V} when is_record(V,valuedef) ->
- NewS = update_state(S,M),
- case check_value(NewS,V) of
- #valuedef{type=#type{def='INTEGER'},value=Value} ->
- validate_integer(NewS,Value,NamedNumberList,Constr);
- _Err -> error({value,"unknown integer referens",S})
+validate_objectidentifier(S, OidType,
+ [{#seqtag{module=Mod,pos=Pos,val=Atom},Val}]) ->
+ %% This case is when an OBJECT IDENTIFIER value has been parsed as a
+ %% SEQUENCE value.
+ Rec = #'Externalvaluereference'{pos=Pos,
+ module=Mod,
+ value=Atom},
+ validate_oid(S, OidType, [Rec,Val], []);
+validate_objectidentifier(S, OidType, [_|_]=L0) ->
+ validate_oid(S, OidType, L0, []);
+validate_objectidentifier(S, OidType, _) ->
+ asn1_error(S, {illegal_oid,OidType}).
+
+get_oid_value(S, OidType, AllowInteger, #'Externalvaluereference'{}=Id) ->
+ case get_referenced_type(S, Id) of
+ {_,#valuedef{checked=Checked,type=Type,value=V}} ->
+ case get_oid_type(S, OidType, Type) of
+ 'INTEGER' when not AllowInteger ->
+ asn1_error(S, {illegal_oid,OidType});
+ _ when Checked ->
+ V;
+ 'INTEGER' ->
+ V;
+ _ ->
+ validate_objectidentifier(S, OidType, V)
end;
_ ->
- error({value,"unknown integer referens",S})
+ asn1_error(S, {illegal_oid,OidType})
end.
-
-
-
-check_integer_range(_Int, Constr) when is_list(Constr) ->
- ok.
-%%------------
-%% This can be removed when the old parser is removed
-%% The function removes 'space' atoms from the list
-
-is_space_list([H],Acc) ->
- lists:reverse([H|Acc]);
-is_space_list([H,space|T],Acc) ->
- is_space_list(T,[H|Acc]);
-is_space_list([],Acc) ->
- lists:reverse(Acc);
-is_space_list([H|T],Acc) ->
- is_space_list(T,[H|Acc]).
-
-validate_objectidentifier(S,OID,ERef,C)
- when is_record(ERef,'Externalvaluereference') ->
- validate_objectidentifier(S,OID,[ERef],C);
-validate_objectidentifier(S,OID,Tup,C) when is_tuple(Tup) ->
- validate_objectidentifier(S,OID,tuple_to_list(Tup),C);
-validate_objectidentifier(S,OID,L,_) ->
- NewL = is_space_list(L,[]),
- case validate_objectidentifier1(S,OID,NewL) of
- NewL2 when is_list(NewL2) ->{ok,list_to_tuple(NewL2)};
- Other -> {ok,Other}
- end.
-
-validate_objectidentifier1(S, OID, [Id|T])
- when is_record(Id,'Externalvaluereference') ->
- case catch get_referenced_type(S,Id) of
- {M,V} when is_record(V,valuedef) ->
- NewS = update_state(S,M),
- case check_value(NewS,V) of
- #valuedef{type=#type{def=ERef},checked=true,
- value=Value} when is_tuple(Value) ->
- case is_object_id(OID,NewS,ERef) of
- true ->
- %% T must be a RELATIVE-OID
- validate_oid(true,NewS, rel_oid, T, lists:reverse(tuple_to_list(Value)));
- _ ->
- error({value, {"illegal "++to_string(OID),[Id|T]}, S})
- end;
- _ ->
- error({value, {"illegal "++to_string(OID),[Id|T]}, S})
- end;
- _ ->
- validate_oid(true,S, OID, [Id|T], [])
- end;
-validate_objectidentifier1(S,OID,V) ->
- validate_oid(true,S,OID,V,[]).
-
-validate_oid(false, S, OID, V, Acc) ->
- error({value, {"illegal "++to_string(OID), V,Acc}, S});
-validate_oid(_,_, _, [], Acc) ->
- lists:reverse(Acc);
-validate_oid(_, S, OID, [Value|Vrest], Acc) when is_integer(Value) ->
- validate_oid(valid_objectid(OID,Value,Acc),S, OID, Vrest, [Value|Acc]);
-validate_oid(_, S, OID, [{'NamedNumber',_Name,Value}|Vrest], Acc)
+validate_oid(S, OidType, [], Acc) ->
+ Oid = lists:reverse(Acc),
+ validate_oid_path(S, OidType, Oid),
+ list_to_tuple(Oid);
+validate_oid(S, OidType, [Value|Vrest], Acc) when is_integer(Value) ->
+ validate_oid(S, OidType, Vrest, [Value|Acc]);
+validate_oid(S, OidType, [{'NamedNumber',_Name,Value}|Vrest], Acc)
when is_integer(Value) ->
- validate_oid(valid_objectid(OID,Value,Acc), S, OID, Vrest, [Value|Acc]);
-validate_oid(_, S, OID, [Id|Vrest], Acc)
- when is_record(Id,'Externalvaluereference') ->
- case catch get_referenced_type(S, Id) of
- {M,V} when is_record(V,valuedef) ->
- NewS = update_state(S,M),
- NewVal = case check_value(NewS, V) of
- #valuedef{checked=true,value=Value} ->
- fun(Int) when is_integer(Int) -> [Int];
- (L) when is_list(L) -> L;
- (T) when is_tuple(T) -> tuple_to_list(T)
- end (Value);
- _ ->
- error({value, {"illegal "++to_string(OID),
- [Id|Vrest],Acc}, S})
- end,
- case NewVal of
- List when is_list(List) ->
- validate_oid(valid_objectid(OID,NewVal,Acc), NewS,
- OID, Vrest,lists:reverse(NewVal)++Acc);
- _ ->
- NewVal
- end;
- _ ->
+ validate_oid(S, OidType, Vrest, [Value|Acc]);
+validate_oid(S, OidType, [#'Externalvaluereference'{}=Id|Vrest], Acc) ->
+ NeededOidType = case Acc of
+ [] -> o_id;
+ [_|_] -> rel_oid
+ end,
+ try get_oid_value(S, NeededOidType, true, Id) of
+ Val when is_integer(Val) ->
+ validate_oid(S, OidType, Vrest, [Val|Acc]);
+ Val when is_tuple(Val) ->
+ L = tuple_to_list(Val),
+ validate_oid(S, OidType, Vrest, lists:reverse(L, Acc))
+ catch
+ _:_ ->
case reserved_objectid(Id#'Externalvaluereference'.value, Acc) of
Value when is_integer(Value) ->
- validate_oid(valid_objectid(OID,Value,Acc),
- S, OID,Vrest, [Value|Acc]);
+ validate_oid(S, OidType,Vrest, [Value|Acc]);
false ->
- error({value, {"illegal "++to_string(OID),[Id,Vrest],Acc}, S})
+ asn1_error(S, {illegal_oid,OidType})
end
end;
-validate_oid(_, S, OID, [{#seqtag{module=Mod,val=Atom},Value}], [])
- when is_atom(Atom),is_integer(Value) ->
- %% this case when an OBJECT IDENTIFIER value has been parsed as a
- %% SEQUENCE value
- Rec = #'Externalvaluereference'{module=Mod,
- value=Atom},
- validate_objectidentifier1(S, OID, [Rec,Value]);
-validate_oid(_, S, OID, [{#seqtag{module=Mod,val=Atom},EVRef}], [])
- when is_atom(Atom),is_record(EVRef,'Externalvaluereference') ->
- %% this case when an OBJECT IDENTIFIER value has been parsed as a
- %% SEQUENCE value OTP-4354
- Rec = #'Externalvaluereference'{module=Mod,
- value=Atom},
- validate_objectidentifier1(S, OID, [Rec,EVRef]);
-validate_oid(_, S, OID, [#seqtag{module=Mod,val=Atom}|Rest], Acc)
- when is_atom(Atom) ->
- Rec = #'Externalvaluereference'{module=Mod,
- value=Atom},
- validate_oid(true,S, OID, [Rec|Rest],Acc);
-validate_oid(_, S, OID, V, Acc) ->
- error({value, {"illegal "++to_string(OID),V,Acc},S}).
-
-is_object_id(OID,S,ERef=#'Externaltypereference'{}) ->
- {_,OI} = get_referenced_type(S,ERef),
- is_object_id(OID,S,OI#typedef.typespec);
-is_object_id(o_id,_S,'OBJECT IDENTIFIER') ->
- true;
-is_object_id(rel_oid,_S,'RELATIVE-OID') ->
- true;
-is_object_id(_,_S,'INTEGER') ->
- true;
-is_object_id(OID,S,#type{def=Def}) ->
- is_object_id(OID,S,Def);
-is_object_id(_,_S,_) ->
- false.
-
-to_string(o_id) ->
- "OBJECT IDENTIFIER";
-to_string(rel_oid) ->
- "RELATIVE-OID".
+validate_oid(S, OidType, _V, _Acc) ->
+ asn1_error(S, {illegal_oid,OidType}).
+
+get_oid_type(S, OidType, #type{def=Def}) ->
+ get_oid_type(S, OidType, Def);
+get_oid_type(S, OidType, #'Externaltypereference'{}=Id) ->
+ {_,OI} = get_referenced_type(S, Id),
+ get_oid_type(S, OidType, OI#typedef.typespec);
+get_oid_type(_S, o_id, 'OBJECT IDENTIFIER'=T) ->
+ T;
+get_oid_type(_S, rel_oid, 'RELATIVE-OID'=T) ->
+ T;
+get_oid_type(_S, _, 'INTEGER'=T) ->
+ T;
+get_oid_type(S, OidType, _) ->
+ asn1_error(S, {illegal_oid,OidType}).
%% ITU-T Rec. X.680 Annex B - D
reserved_objectid('itu-t',[]) -> 0;
@@ -2380,7 +1903,6 @@ reserved_objectid('x',[0,0]) -> 24;
reserved_objectid('y',[0,0]) -> 25;
reserved_objectid('z',[0,0]) -> 26;
-
reserved_objectid(iso,[]) -> 1;
%% arcs below "iso", note that number 1 is not used
reserved_objectid('standard',[1]) -> 0;
@@ -2392,25 +1914,22 @@ reserved_objectid('joint-iso-ccitt',[]) -> 2;
reserved_objectid(_,_) -> false.
-valid_objectid(_OID,[],_Acc) ->
- true;
-valid_objectid(OID,[H|T],Acc) ->
- case valid_objectid(OID, H, Acc) of
- true ->
- valid_objectid(OID,T,[H|Acc]);
- _ ->
- false
- end;
-valid_objectid(o_id,I,[]) when I =:= 0; I =:= 1; I =:= 2 -> true;
-valid_objectid(o_id,_I,[]) -> false;
-valid_objectid(o_id,I,[0]) when I >= 0; I =< 4 -> true;
-valid_objectid(o_id,_I,[0]) -> false;
-valid_objectid(o_id,I,[1]) when I =:= 0; I =:= 2; I =:= 3 -> true;
-valid_objectid(o_id,_I,[1]) -> false;
-valid_objectid(o_id,_I,[2]) -> true;
-valid_objectid(_,_,_) -> true.
-
-convert_external(S=#state{type=Vtype}, Value) ->
+validate_oid_path(_, rel_oid, _) ->
+ ok;
+validate_oid_path(_, o_id, [0,I|_]) when 0 =< I, I =< 9 ->
+ ok;
+validate_oid_path(_, o_id, [1,I|_]) when 0 =< I, I =< 3 ->
+ ok;
+validate_oid_path(_, o_id, [2|_]) ->
+ ok;
+validate_oid_path(S, o_id=OidType, _) ->
+ asn1_error(S, {illegal_oid,OidType}).
+
+%%%
+%%% End of OBJECT IDENTFIER/RELATIVE-OID validation.
+%%%
+
+convert_external(S, Vtype, Value) ->
case Vtype of
#type{tag=[{tag,'UNIVERSAL',8,'IMPLICIT',32}]} ->
%% this is an 'EXTERNAL' (or INSTANCE OF)
@@ -2435,7 +1954,7 @@ to_EXTERNAL1990(S, [{#seqtag{val=identification}=T,
to_EXTERNAL1990(S, Rest, [{T#seqtag{val='indirect-reference'},PCid},
{T#seqtag{val='direct-reference'},TrStx}]);
to_EXTERNAL1990(S, _) ->
- error({value,"illegal value in EXTERNAL type",S}).
+ asn1_error(S, illegal_external_value).
to_EXTERNAL1990(S, [V={#seqtag{val='data-value-descriptor'},_}|Rest], Acc) ->
to_EXTERNAL1990(S, Rest, [V|Acc]);
@@ -2443,7 +1962,7 @@ to_EXTERNAL1990(_S, [{#seqtag{val='data-value'}=T,Val}], Acc) ->
Encoding = {T#seqtag{val=encoding},{'CHOICE',{'octet-aligned',Val}}},
lists:reverse([Encoding|Acc]);
to_EXTERNAL1990(S, _, _) ->
- error({value,"illegal value in EXTERNAL type",S}).
+ asn1_error(S, illegal_external_value).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Functions to normalize the default values of SEQUENCE
@@ -2453,17 +1972,16 @@ normalize_value(_,_,mandatory,_) ->
mandatory;
normalize_value(_,_,'OPTIONAL',_) ->
'OPTIONAL';
-normalize_value(S0, Type, {'DEFAULT',Value}, NameList) ->
- S = S0#state{value=Value},
+normalize_value(S, Type, {'DEFAULT',Value}, NameList) ->
case catch get_canonic_type(S,Type,NameList) of
{'BOOLEAN',CType,_} ->
normalize_boolean(S,Value,CType);
{'INTEGER',CType,_} ->
- normalize_integer(S,Value,CType);
+ normalize_integer(S, Value, CType);
{'BIT STRING',CType,_} ->
normalize_bitstring(S,Value,CType);
- {'OCTET STRING',CType,_} ->
- normalize_octetstring(S0, Value, CType);
+ {'OCTET STRING',_,_} ->
+ normalize_octetstring(S, Value);
{'NULL',_CType,_} ->
%%normalize_null(Value);
'NULL';
@@ -2499,39 +2017,41 @@ normalize_value(S0, Type, {'DEFAULT',Value}, NameList) ->
normalize_value(S,Type,Val,NameList) ->
normalize_value(S,Type,{'DEFAULT',Val},NameList).
-normalize_boolean(S,{Name,Bool},CType) when is_atom(Name) ->
- normalize_boolean(S,Bool,CType);
normalize_boolean(_,true,_) ->
true;
normalize_boolean(_,false,_) ->
false;
normalize_boolean(S,Bool=#'Externalvaluereference'{},CType) ->
get_normalized_value(S,Bool,CType,fun normalize_boolean/3,[]);
-normalize_boolean(_,Other,_) ->
- throw({error,{asn1,{'invalid default value',Other}}}).
+normalize_boolean(S, _, _) ->
+ asn1_error(S, {illegal_value, "BOOLEAN"}).
-normalize_integer(_S,Int,_) when is_integer(Int) ->
+normalize_integer(_S, Int, _) when is_integer(Int) ->
Int;
-normalize_integer(_S,{Name,Int},_) when is_atom(Name),is_integer(Int) ->
- Int;
-normalize_integer(S,{Name,Int=#'Externalvaluereference'{}},
- Type) when is_atom(Name) ->
- normalize_integer(S,Int,Type);
-normalize_integer(S,Int=#'Externalvaluereference'{value=Name},Type) ->
- case Type of
- NNL when is_list(NNL) ->
- case lists:keysearch(Name,1,NNL) of
- {value,{Name,Val}} ->
+normalize_integer(S, #'Externalvaluereference'{value=Name}=Ref, NNL) ->
+ case lists:keyfind(Name, 1, NNL) of
+ {Name,Val} ->
+ Val;
+ false ->
+ try get_referenced_value(S, Ref) of
+ Val when is_integer(Val) ->
Val;
- false ->
- get_normalized_value(S,Int,Type,
- fun normalize_integer/3,[])
- end;
+ _ ->
+ asn1_error(S, illegal_integer_value)
+ catch
+ throw:_ ->
+ asn1_error(S, illegal_integer_value)
+ end
+ end;
+normalize_integer(S, {'ValueFromObject',{object,Obj},FieldNames}, _) ->
+ case extract_field(S, Obj, FieldNames) of
+ #valuedef{value=Val} when is_integer(Val) ->
+ Val;
_ ->
- get_normalized_value(S,Int,Type,fun normalize_integer/3,[])
+ asn1_error(S, illegal_integer_value)
end;
-normalize_integer(_,Int,_) ->
- exit({'Unknown INTEGER value',Int}).
+normalize_integer(S, _, _) ->
+ asn1_error(S, illegal_integer_value).
%% normalize_bitstring(S, Value, Type) -> bitstring()
%% Convert a literal value for a BIT STRING to an Erlang bit string.
@@ -2543,36 +2063,34 @@ normalize_bitstring(S, Value, Type)->
{bstring,String} when is_list(String) ->
bstring_to_bitstring(String);
#'Externalvaluereference'{} ->
- get_normalized_value(S, Value, Type,
- fun normalize_bitstring/3, []);
- RecList when is_list(RecList) ->
- F = fun(#'Externalvaluereference'{value=Name}) ->
- case lists:keymember(Name, 1, Type) of
- true -> Name;
- false -> throw({error,false})
- end;
- (Name) when is_atom(Name) ->
- %% Already normalized.
- Name;
- (Other) ->
- throw({error,Other})
- end,
- try
- lists:map(F, RecList)
- catch
- throw:{error,Reason} ->
- asn1ct:warning("default value not "
- "compatible with type definition ~p~n",
- [Reason],S,
- "default value not "
- "compatible with type definition"),
- Value
+ Val = get_referenced_value(S, Value),
+ normalize_bitstring(S, Val, Type);
+ {'ValueFromObject',{object,Obj},FieldNames} ->
+ case extract_field(S, Obj, FieldNames) of
+ #valuedef{value=Val} ->
+ normalize_bitstring(S, Val, Type);
+ _ ->
+ asn1_error(S, {illegal_value, "BIT STRING"})
end;
+ RecList when is_list(RecList) ->
+ [normalize_bs_item(S, Item, Type) || Item <- RecList];
Bs when is_bitstring(Bs) ->
%% Already normalized.
- Bs
+ Bs;
+ _ ->
+ asn1_error(S, {illegal_value, "BIT STRING"})
end.
+normalize_bs_item(S, #'Externalvaluereference'{value=Name}, Type) ->
+ case lists:keymember(Name, 1, Type) of
+ true -> Name;
+ false -> asn1_error(S, {illegal_value, "BIT STRING"})
+ end;
+normalize_bs_item(_, Atom, _) when is_atom(Atom) ->
+ Atom;
+normalize_bs_item(S, _, _) ->
+ asn1_error(S, {illegal_value, "BIT STRING"}).
+
hstring_to_binary(L) ->
byte_align(hstring_to_bitstring(L)).
@@ -2600,29 +2118,35 @@ hex_to_int(D) when $A =< D, D =< $F -> D - ($A - 10).
%% {bstring,String} each element in String corresponds to one bit in an octet
%% {hstring,String} each element in String corresponds to one byte in an octet
%% #'Externalvaluereference'
-normalize_octetstring(S,Value,CType) ->
+normalize_octetstring(S, Value) ->
case Value of
{bstring,String} ->
bstring_to_binary(String);
{hstring,String} ->
hstring_to_binary(String);
- Rec when is_record(Rec,'Externalvaluereference') ->
- get_normalized_value(S,Value,CType,
- fun normalize_octetstring/3,[]);
- {Name,String} when is_atom(Name) ->
- normalize_octetstring(S,String,CType);
+ #'Externalvaluereference'{} ->
+ case get_referenced_value(S, Value) of
+ String when is_binary(String) ->
+ String;
+ Other ->
+ normalize_octetstring(S, Other)
+ end;
+ {'ValueFromObject',{object,Obj},FieldNames} ->
+ case extract_field(S, Obj, FieldNames) of
+ #valuedef{value=Val} when is_binary(Val) ->
+ Val;
+ _ ->
+ asn1_error(S, illegal_octet_string_value)
+ end;
_ ->
- Item = S#state.value,
- asn1_error(S, Item, illegal_octet_string_value)
+ asn1_error(S, illegal_octet_string_value)
end.
normalize_objectidentifier(S, Value) ->
- {ok,Val} = validate_objectidentifier(S, o_id, Value, []),
- Val.
+ validate_objectidentifier(S, o_id, Value).
-normalize_relative_oid(S,Value) ->
- {ok,Val} = validate_objectidentifier(S, rel_oid, Value, []),
- Val.
+normalize_relative_oid(S, Value) ->
+ validate_objectidentifier(S, rel_oid, Value).
normalize_objectdescriptor(Value) ->
Value.
@@ -2644,40 +2168,22 @@ lookup_enum_value(S, Id, NNL) when is_atom(Id) ->
{_,_}=Ret ->
Ret;
false ->
- asn1_error(S, S#state.value, {undefined,Id})
+ asn1_error(S, {undefined,Id})
end.
-normalize_choice(S,{'CHOICE',{C,V}},CType,NameList) when is_atom(C) ->
- case catch lists:keysearch(C,#'ComponentType'.name,CType) of
- {value,#'ComponentType'{typespec=CT,name=Name}} ->
- {C,normalize_value(S,CT,{'DEFAULT',V},
- [Name|NameList])};
- Other ->
- asn1ct:warning("Wrong format of type/value ~p/~p~n",[Other,V],S,
- "Wrong format of type/value"),
- {C,V}
+normalize_choice(S, {'CHOICE',{C,V}}, CType, NameList)
+ when is_atom(C) ->
+ case lists:keyfind(C, #'ComponentType'.name, CType) of
+ #'ComponentType'{typespec=CT,name=Name} ->
+ {C,normalize_value(S, CT, {'DEFAULT',V}, [Name|NameList])};
+ false ->
+ asn1_error(S, {illegal_id,C})
end;
-normalize_choice(S,{'DEFAULT',ValueList},CType,NameList) when is_list(ValueList) ->
- lists:map(fun(X)-> normalize_choice(S,X,CType,NameList) end, ValueList);
-normalize_choice(S,Val=#'Externalvaluereference'{},CType,NameList) ->
- {M,#valuedef{value=V}}=get_referenced_type(S,Val),
- normalize_choice(update_state(S,M),{'CHOICE',V},CType,NameList);
-% get_normalized_value(S,Val,CType,fun normalize_choice/4,[NameList]);
-normalize_choice(S,CV={Name,_ChoiceVal},CType,NameList)
+normalize_choice(S,CV={Name,_ChoiceVal},CType,NameList)
when is_atom(Name) ->
-% normalize_choice(S,ChoiceVal,CType,NameList).
normalize_choice(S,{'CHOICE',CV},CType,NameList);
-normalize_choice(_S,V,_CType,_NameList) ->
- exit({error,{bad_choice_value,V}}).
-
-%% normalize_choice(NameList,S,CVal = {'CHOICE',{_,_}},CType,_) ->
-%% normalize_choice(S,CVal,CType,NameList);
-%% normalize_choice(NameList,S,CVal={'DEFAULT',VL},CType,_) when is_list(VL)->
-%% normalize_choice(S,CVal,CType,NameList);
-%% normalize_choice(NameList,S,CV={Name,_CV},CType,_) when is_atom(Name)->
-%% normalize_choice(S,{'CHOICE',CV},CType,NameList);
-%% normalize_choice(_,_S,V,_,_) ->
-%% V.
+normalize_choice(S, V, _CType, _NameList) ->
+ asn1_error(S, {illegal_id, error_value(V)}).
normalize_sequence(S,Value,Components,NameList)
when is_tuple(Components) ->
@@ -2732,12 +2238,9 @@ normalized_record(SorS,S,Value,Components,NameList) ->
Value;
_ ->
NoComps = length(Components),
- case normalize_seq_or_set(SorS,S,Value,Components,NameList,[]) of
- ListOfVals when length(ListOfVals) == NoComps ->
- list_to_tuple([NewName|ListOfVals]);
- _ ->
- error({type,{illegal,default,value,Value},S})
- end
+ ListOfVals = normalize_seq_or_set(SorS,S,Value,Components,NameList,[]),
+ NoComps = length(ListOfVals), %% Assert
+ list_to_tuple([NewName|ListOfVals])
end.
is_record_normalized(S,Name,V = #'Externalvaluereference'{},NumComps) ->
case get_referenced_type(S,V) of
@@ -2750,10 +2253,11 @@ is_record_normalized(_S,Name,Value,NumComps) when is_tuple(Value) ->
is_record_normalized(_,_,_,_) ->
false.
-normalize_seq_or_set(SorS, S, [{#seqtag{val=Cname},V}|Vs],
+normalize_seq_or_set(SorS, S,
+ [{#seqtag{val=Cname},V}|Vs],
[#'ComponentType'{name=Cname,typespec=TS}|Cs],
NameList, Acc) ->
- NewNameList =
+ NewNameList =
case TS#type.def of
#'Externaltypereference'{type=TName} ->
[TName];
@@ -2761,24 +2265,26 @@ normalize_seq_or_set(SorS, S, [{#seqtag{val=Cname},V}|Vs],
end,
NVal = normalize_value(S,TS,{'DEFAULT',V},NewNameList),
normalize_seq_or_set(SorS,S,Vs,Cs,NameList,[NVal|Acc]);
-normalize_seq_or_set(SorS,S,Values=[{_Cname1,_V}|_Vs],
+normalize_seq_or_set(SorS, S,
+ Values=[{#seqtag{val=Cname0},_V}|_Vs],
[#'ComponentType'{prop='OPTIONAL'}|Cs],
- NameList,Acc) ->
+ NameList, Acc) ->
+ verify_valid_component(S, Cname0, Cs),
normalize_seq_or_set(SorS,S,Values,Cs,NameList,[asn1_NOVALUE|Acc]);
-normalize_seq_or_set(SorS,S,Values=[{_Cname1,_V}|_Vs],
- [#'ComponentType'{name=Cname2,typespec=TS,
- prop={'DEFAULT',Value}}|Cs],
- NameList,Acc) ->
- NewNameList =
+normalize_seq_or_set(SorS, S,
+ Values=[{#seqtag{val=Cname0},_V}|_Vs],
+ [#'ComponentType'{name=Cname,typespec=TS,
+ prop={'DEFAULT',Value}}|Cs],
+ NameList, Acc) ->
+ verify_valid_component(S, Cname0, Cs),
+ NewNameList =
case TS#type.def of
#'Externaltypereference'{type=TName} ->
[TName];
- _ -> [Cname2|NameList]
+ _ -> [Cname|NameList]
end,
NVal = normalize_value(S,TS,{'DEFAULT',Value},NewNameList),
normalize_seq_or_set(SorS,S,Values,Cs,NameList,[NVal|Acc]);
-normalize_seq_or_set(_SorS,_S,[],[],_,Acc) ->
- lists:reverse(Acc);
%% If default value is {} ComponentTypes in SEQUENCE are marked DEFAULT
%% or OPTIONAL (or the type is defined SEQUENCE{}, which is handled by
%% the previous case).
@@ -2801,9 +2307,23 @@ normalize_seq_or_set(SorS,S,Value=#'Externalvaluereference'{},
Cs,NameList,Acc) ->
get_normalized_value(S,Value,Cs,fun normalize_seq_or_set/6,
[SorS,NameList,Acc]);
-normalize_seq_or_set(_SorS,S,V,_,_,_) ->
- error({type,{illegal,default,value,V},S}).
-
+normalize_seq_or_set(_SorS, _S, [], [], _, Acc) ->
+ lists:reverse(Acc);
+normalize_seq_or_set(_SorS, S, V, Cs, _, _) ->
+ case V of
+ [{#seqtag{val=Name},_}|_] ->
+ asn1_error(S, {illegal_id,error_value(Name)});
+ [] ->
+ [#'ComponentType'{name=Name}|_] = Cs,
+ asn1_error(S, {missing_id,error_value(Name)})
+ end.
+
+verify_valid_component(S, Name, Cs) ->
+ case lists:keyfind(Name, #'ComponentType'.name, Cs) of
+ false -> asn1_error(S, {illegal_id,error_value(Name)});
+ #'ComponentType'{} -> ok
+ end.
+
normalize_seqof(S,Value,Type,NameList) ->
normalize_s_of('SEQUENCE OF',S,Value,Type,NameList).
@@ -2859,10 +2379,7 @@ normalize_restrictedstring(_S,CString,_) when is_list(CString) ->
%% definedvalue case or argument in a parameterized type
normalize_restrictedstring(S,ERef,CType) when is_record(ERef,'Externalvaluereference') ->
get_normalized_value(S,ERef,CType,
- fun normalize_restrictedstring/3,[]);
-%%
-normalize_restrictedstring(S,{Name,Val},CType) when is_atom(Name) ->
- normalize_restrictedstring(S,Val,CType).
+ fun normalize_restrictedstring/3,[]).
normalize_objectclassfieldvalue(S,{opentypefieldvalue,Type,Value},NameList) ->
%% An open type has per definition no type. Thus should the type
@@ -2910,6 +2427,8 @@ call_Func(S,Val,Type,Func,ArgList) ->
get_canonic_type(S,Type,NameList) ->
{InnerType,NewType,NewNameList} =
case Type#type.def of
+ 'INTEGER'=Name ->
+ {Name,[],NameList};
Name when is_atom(Name) ->
{Name,Type,NameList};
Ref when is_record(Ref,'Externaltypereference') ->
@@ -2964,8 +2483,8 @@ check_formal_parameter(_, {_,_}) ->
ok;
check_formal_parameter(_, #'Externaltypereference'{}) ->
ok;
-check_formal_parameter(S, #'Externalvaluereference'{value=Name}=Ref) ->
- asn1_error(S, Ref, {illegal_typereference,Name}).
+check_formal_parameter(S, #'Externalvaluereference'{value=Name}) ->
+ asn1_error(S, {illegal_typereference,Name}).
% check_type(S,Type,ObjSpec={{objectclassname,_},_}) ->
% check_class(S,ObjSpec);
@@ -2977,7 +2496,7 @@ check_type(_S,Type,Ts) when is_record(Type,typedef),
Ts;
check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
{Def,Tag,Constr,IsInlined} =
- case match_parameters(S,Ts#type.def,S#state.parameters) of
+ case match_parameter(S, Ts#type.def) of
#type{tag=PTag,constraint=_Ctmp,def=Dtmp,inlined=Inl} ->
{Dtmp,merge_tags(Ts#type.tag,PTag),Ts#type.constraint,Inl};
#typedef{typespec=#type{tag=PTag,def=Dtmp,inlined=Inl}} ->
@@ -2989,16 +2508,16 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
inlined=IsInlined},
TestFun =
fun(Tref) ->
- MaybeChoice = get_non_typedef(S, Tref),
+ {_, MaybeChoice} = get_referenced_type(S, Tref, true),
case catch((MaybeChoice#typedef.typespec)#type.def) of
{'CHOICE',_} ->
- maybe_illicit_implicit_tag(choice,Tag);
+ maybe_illicit_implicit_tag(S, choice, Tag);
'ANY' ->
- maybe_illicit_implicit_tag(open_type,Tag);
+ maybe_illicit_implicit_tag(S, open_type, Tag);
'ANY DEFINED BY' ->
- maybe_illicit_implicit_tag(open_type,Tag);
+ maybe_illicit_implicit_tag(S, open_type, Tag);
'ASN1_OPEN_TYPE' ->
- maybe_illicit_implicit_tag(open_type,Tag);
+ maybe_illicit_implicit_tag(S, open_type, Tag);
_ ->
Tag
end
@@ -3007,7 +2526,7 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
case Def of
Ext when is_record(Ext,'Externaltypereference') ->
{RefMod,RefTypeDef,IsParamDef} =
- case get_referenced_type(S,Ext) of
+ case get_referenced_type(S, Ext) of
{undefined,TmpTDef} -> %% A parameter
{get(top_module),TmpTDef,true};
{TmpRefMod,TmpRefDef} ->
@@ -3031,7 +2550,6 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
NewS = S#state{mname=RefMod,
module=load_asn1_module(S,RefMod),
tname=get_datastr_name(NewRefTypeDef1),
- type=NewRefTypeDef1,
abscomppath=[],recordtopname=[]},
RefType1 =
check_type(NewS,RefTypeDef,RefTypeDef#typedef.typespec),
@@ -3051,18 +2569,17 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
Key);
_ -> ok
end,
+ Pos = Ext#'Externaltypereference'.pos,
{RefType1,#'Externaltypereference'{module=RefMod,
+ pos=Pos,
type=TmpName}}
end,
case asn1ct_gen:prim_bif(asn1ct_gen:get_inner(RefType#type.def)) of
true ->
%% Here we expand to a built in type and inline it
- NewS2 = S#state{type=#typedef{typespec=RefType}},
- NewC =
- constraint_merge(NewS2,
- check_constraints(NewS2,Constr)++
- RefType#type.constraint),
+ NewC = check_constraints(S, RefType, Constr ++
+ RefType#type.constraint),
TempNewDef#newt{
type = RefType#type.def,
tag = merge_tags(Ct,RefType#type.tag),
@@ -3073,19 +2590,13 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
NewExt = ExtRef#'Externaltypereference'{module=merged_mod(S,RefMod,Ext)},
TempNewDef#newt{
type = check_externaltypereference(S,NewExt),
- tag = case S#state.erule of
- ber ->
- merge_tags(Ct,RefType#type.tag);
- _ ->
- Ct
- end
- }
+ tag = merge_tags(Ct,RefType#type.tag)}
end;
'ANY' ->
- Ct=maybe_illicit_implicit_tag(open_type,Tag),
+ Ct = maybe_illicit_implicit_tag(S, open_type, Tag),
TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct};
{'ANY_DEFINED_BY',_} ->
- Ct=maybe_illicit_implicit_tag(open_type,Tag),
+ Ct = maybe_illicit_implicit_tag(S, open_type, Tag),
TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct};
'INTEGER' ->
TempNewDef#newt{tag=
@@ -3132,7 +2643,7 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
{'ENUMERATED',NamedNumberList} ->
TempNewDef#newt{type=
{'ENUMERATED',
- check_enumerated(S,NamedNumberList,Constr)},
+ check_enumerated(S, NamedNumberList)},
tag=
merge_tags(Tag,?TAG_PRIMITIVE(?N_ENUMERATED)),
constraint=[]};
@@ -3235,7 +2746,7 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
tag=
merge_tags(Tag,?TAG_CONSTRUCTED(?N_SEQUENCE))};
{'CHOICE',Components} ->
- Ct = maybe_illicit_implicit_tag(choice,Tag),
+ Ct = maybe_illicit_implicit_tag(S, choice, Tag),
TempNewDef#newt{type={'CHOICE',check_choice(S,Type,Components)},tag=Ct};
Set when is_record(Set,'SET') ->
RecordName=
@@ -3258,12 +2769,6 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
TempNewDef#newt{type={'SET OF',check_setof(S,Type,Components)},
tag=
merge_tags(Tag,?TAG_CONSTRUCTED(?N_SET))};
- %% This is a temporary hack until the full Information Obj Spec
- %% in X.681 is supported
- {#'Externaltypereference'{type='TYPE-IDENTIFIER'},
- [{typefieldreference,_,'Type'}]} ->
- Ct=maybe_illicit_implicit_tag(open_type,Tag),
- TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct};
{pt,Ptype,ParaList} ->
%% Ptype might be a parameterized - type, object set or
@@ -3271,18 +2776,18 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
%% calling function.
{_RefMod,Ptypedef} = get_referenced_type(S,Ptype),
notify_if_not_ptype(S,Ptypedef),
- NewParaList =
- [match_parameters(S,TmpParam,S#state.parameters)||
- TmpParam <- ParaList],
+ NewParaList = match_parameters(S, ParaList),
Instance = instantiate_ptype(S,Ptypedef,NewParaList),
TempNewDef#newt{type=Instance#type.def,
tag=merge_tags(Tag,Instance#type.tag),
constraint=Instance#type.constraint,
inlined=yes};
- OCFT=#'ObjectClassFieldType'{classname=ClRef} ->
+ #'ObjectClassFieldType'{classname=ClRef0}=OCFT0 ->
%% this case occures in a SEQUENCE when
%% the type of the component is a ObjectClassFieldType
+ ClRef = match_parameter(S, ClRef0),
+ OCFT = OCFT0#'ObjectClassFieldType'{classname=ClRef},
ClassSpec = check_class(S,ClRef),
NewTypeDef =
maybe_open_type(S,ClassSpec,
@@ -3292,16 +2797,18 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
Ct =
case is_open_type(NewTypeDef) of
true ->
- maybe_illicit_implicit_tag(open_type,MergedTag);
+ maybe_illicit_implicit_tag(S, open_type, MergedTag);
_ ->
MergedTag
end,
case TopName of
[] when Type#typedef.name =/= undefined ->
%% This is a top-level type.
- #type{def=Simplified} =
- simplify_type(#type{def=NewTypeDef}),
- TempNewDef#newt{type=Simplified,tag=Ct};
+ #type{constraint=C,def=Simplified} =
+ simplify_type(#type{def=NewTypeDef,
+ constraint=Constr}),
+ TempNewDef#newt{type=Simplified,tag=Ct,
+ constraint=C};
_ ->
TempNewDef#newt{type=NewTypeDef,tag=Ct}
end;
@@ -3311,33 +2818,21 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) ->
TempNewDef#newt{tag=merge_tags(Tag,CheckedT#type.tag),
type=CheckedT#type.def};
- {valueset,Vtype} ->
- TempNewDef#newt{type={valueset,check_type(S,Type,Vtype)}};
{'SelectionType',Name,T} ->
CheckedT = check_selectiontype(S,Name,T),
TempNewDef#newt{tag=merge_tags(Tag,CheckedT#type.tag),
type=CheckedT#type.def};
- Other ->
- exit({'cant check' ,Other})
+ 'ASN1_OPEN_TYPE' ->
+ TempNewDef
end,
#newt{type=TDef,tag=NewTags,constraint=NewConstr,inlined=Inlined} = NewDef,
Ts#type{def=TDef,
inlined=Inlined,
- constraint=check_constraints(S, NewConstr),
+ constraint=check_constraints(S, #type{def=TDef}, NewConstr),
tag=lists:map(fun(#tag{type={default,TTx}}=TempTag) ->
TempTag#tag{type=TTx};
(Other) -> Other
- end, NewTags)};
-check_type(_S,Type,Ts) ->
- exit({error,{asn1,internal_error,Type,Ts}}).
-
-get_non_typedef(S, Tref0) ->
- case get_referenced_type(S, Tref0) of
- {_,#typedef{typespec=#type{def=#'Externaltypereference'{}=Tref}}} ->
- get_non_typedef(S, Tref);
- {_,Type} ->
- Type
- end.
+ end, NewTags)}.
%%
@@ -3353,10 +2848,11 @@ simplify_comp(#'ComponentType'{typespec=Type0}=C) ->
C#'ComponentType'{typespec=Type};
simplify_comp(Other) -> Other.
-simplify_type(#type{tag=Tag,def=Inner}=T) ->
+simplify_type(#type{tag=Tag,def=Inner,constraint=Constr0}=T) ->
case Inner of
- #'ObjectClassFieldType'{type={fixedtypevaluefield,_,Type}} ->
- Type#type{tag=Tag};
+ #'ObjectClassFieldType'{type={fixedtypevaluefield,_,Type}}=OCFT ->
+ Constr = [{ocft,OCFT}|Type#type.constraint++Constr0],
+ Type#type{tag=Tag,constraint=Constr};
_ ->
T
end.
@@ -3389,29 +2885,22 @@ get_innertag(_S,#'ObjectClassFieldType'{type=Type}) ->
_ -> []
end.
-get_type_from_object(S,Object,TypeField)
- when is_record(Object,'Externaltypereference');
- is_record(Object,'Externalvaluereference') ->
- {_,ObjectDef} = get_referenced_type(S,Object),
- ObjSpec = check_object(S,ObjectDef,ObjectDef#typedef.typespec),
- get_fieldname_element(S,ObjectDef#typedef{typespec=ObjSpec},TypeField).
-
%% get_class_def(S, Type) -> #classdef{} | 'none'.
get_class_def(S, #typedef{typespec=#type{def=#'Externaltypereference'{}=Eref}}) ->
- {_,NextDef} = get_referenced_type(S, Eref),
+ {_,NextDef} = get_referenced_type(S, Eref, true),
get_class_def(S, NextDef);
get_class_def(S, #'Externaltypereference'{}=Eref) ->
- {_,NextDef} = get_referenced_type(S, Eref),
+ {_,NextDef} = get_referenced_type(S, Eref, true),
get_class_def(S, NextDef);
get_class_def(_S, #classdef{}=CD) ->
CD;
get_class_def(_S, _) ->
none.
-maybe_illicit_implicit_tag(Kind,Tag) ->
+maybe_illicit_implicit_tag(S, Kind, Tag) ->
case Tag of
[#tag{type='IMPLICIT'}|_T] ->
- throw({error,{asn1,{implicit_tag_before,Kind}}});
+ asn1_error(S, {implicit_tag_before,Kind});
[ChTag = #tag{type={default,_}}|T] ->
case Kind of
open_type ->
@@ -3438,19 +2927,24 @@ merged_mod(S,RefMod,Ext) ->
%% any UNIQUE field, so that a component relation constraint cannot specify
%% the type of a typefield, return 'ASN1_OPEN_TYPE'.
%%
-maybe_open_type(S,ClassSpec=#objectclass{fields=Fs},
- OCFT=#'ObjectClassFieldType'{fieldname=FieldRefList},
+maybe_open_type(_, _, #'ObjectClassFieldType'{fieldname={_,_}}=OCFT, _) ->
+ %% Already converted.
+ OCFT;
+maybe_open_type(S, #objectclass{fields=Fs}=ClassSpec,
+ #'ObjectClassFieldType'{fieldname=FieldRefList}=OCFT,
Constr) ->
- Type = get_ObjectClassFieldType(S,Fs,FieldRefList),
- FieldNames=get_referenced_fieldname(FieldRefList),
- case last_fieldname(FieldRefList) of
+ Type = get_OCFType(S, Fs, FieldRefList),
+ FieldNames = get_referenced_fieldname(FieldRefList),
+ case lists:last(FieldRefList) of
{valuefieldreference,_} ->
OCFT#'ObjectClassFieldType'{fieldname=FieldNames,
type=Type};
{typefieldreference,_} ->
- case {catch get_unique_fieldname(S,#classdef{typespec=ClassSpec}),
- asn1ct_gen:get_constraint(Constr,componentrelation)}of
- {Tuple,_} when tuple_size(Tuple) =:= 3 ->
+ %% Note: The constraints have not been checked yet,
+ %% so we must use a special lookup routine.
+ case {get_unique_fieldname(S, #classdef{typespec=ClassSpec}),
+ get_componentrelation(Constr)} of
+ {no_unique,_} ->
OCFT#'ObjectClassFieldType'{fieldname=FieldNames,
type='ASN1_OPEN_TYPE'};
{_,no} ->
@@ -3462,16 +2956,12 @@ maybe_open_type(S,ClassSpec=#objectclass{fields=Fs},
end
end.
-last_fieldname(FieldRefList) when is_list(FieldRefList) ->
- lists:last(FieldRefList);
-last_fieldname({FieldName,_}) when is_atom(FieldName) ->
- [A|_] = atom_to_list(FieldName),
- case is_lowercase(A) of
- true ->
- {valuefieldreference,FieldName};
- _ ->
- {typefieldreference,FieldName}
- end.
+get_componentrelation([{element_set,{componentrelation,_,_}=Cr,none}|_]) ->
+ Cr;
+get_componentrelation([_|T]) ->
+ get_componentrelation(T);
+get_componentrelation([]) ->
+ no.
is_open_type(#'ObjectClassFieldType'{type='ASN1_OPEN_TYPE'}) ->
true;
@@ -3510,35 +3000,19 @@ notify_if_not_ptype(S,#pobjectsetdef{class=Cl}) ->
_ ->
throw(pobjectsetdef)
end;
-notify_if_not_ptype(_S,PT) ->
- throw({error,{"supposed to be a parameterized type",PT}}).
-% fix me
+notify_if_not_ptype(S, PT) ->
+ asn1_error(S, {param_bad_type, error_value(PT)}).
+
instantiate_ptype(S,Ptypedef,ParaList) ->
#ptypedef{args=Args,typespec=Type} = Ptypedef,
NewType = check_ptype(S,Ptypedef,Type#type{inlined=yes}),
MatchedArgs = match_args(S,Args, ParaList, []),
OldArgs = S#state.parameters,
- NewS = S#state{type=NewType,parameters=MatchedArgs++OldArgs,abscomppath=[]},
-%% NewS = S#state{type=NewType,parameters=MatchedArgs,abscomppath=[]},
+ NewS = S#state{parameters=MatchedArgs++OldArgs,abscomppath=[]},
check_type(NewS, Ptypedef#ptypedef{typespec=NewType}, NewType).
-get_datastr_name(#typedef{name=N}) ->
- N;
-get_datastr_name(#classdef{name=N}) ->
- N;
-get_datastr_name(#valuedef{name=N}) ->
- N;
-get_datastr_name(#ptypedef{name=N}) ->
- N;
-get_datastr_name(#pvaluedef{name=N}) ->
- N;
-get_datastr_name(#pvaluesetdef{name=N}) ->
- N;
-get_datastr_name(#pobjectdef{name=N}) ->
- N;
-get_datastr_name(#pobjectsetdef{name=N}) ->
- N.
-
+get_datastr_name(Type) ->
+ asn1ct:get_name_of_def(Type).
get_pt_args(#ptypedef{args=Args}) ->
Args;
@@ -3606,8 +3080,8 @@ match_args(S,FA = [FormArg|Ft], AA = [ActArg|At], Acc) ->
end;
match_args(_S,[], [], Acc) ->
lists:reverse(Acc);
-match_args(_,_, _, _) ->
- throw({error,{asn1,{wrong_number_of_arguments}}}).
+match_args(S, _, _, _) ->
+ asn1_error(S, param_wrong_number_of_arguments).
%%%%%%%%%%%%%%%%%
%% categorize_arg(S,FormalArg,ActualArg) -> {FormalArg,CatgorizedActualArg}
@@ -3652,11 +3126,6 @@ parameter_name_style(#'Externaltypereference'{}) ->
parameter_name_style(#'Externalvaluereference'{}) ->
beginning_lowercase.
-is_lowercase(X) when X >= $A,X =< $W ->
- false;
-is_lowercase(_) ->
- true.
-
%% categorize(Parameter) -> CategorizedParameter
%% If Parameter has an abstract syntax of another category than
%% Category, transform it to a known syntax.
@@ -3705,725 +3174,503 @@ parse_objectset(Set) ->
Set.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% check_constraints/2
-%%
-check_constraints(S,C) when is_list(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);
-resolv_tuple_or_list(S,{Lb,Ub}) ->
- {resolv_value(S,Lb),resolv_value(S,Ub)}.
-
-%%%-----------------------------------------
-%% If the constraint value is a defined value the valuename
-%% is replaced by the actual value
%%
-resolv_value(S,Val) ->
- Id = match_parameters(S,Val, S#state.parameters),
- resolv_value1(S,Id).
+%% Check and simplify constraints.
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-resolv_value1(S, ERef = #'Externalvaluereference'{value=Name}) ->
- case catch resolve_namednumber(S, S#state.type, Name) of
- V when is_integer(V) ->
- V;
- _ ->
- case get_referenced_type(S,ERef) of
- {Err,_Reason} when Err == error; Err == 'EXIT' ->
- throw({error,{asn1,{undefined_type_or_value,
- Name}}});
- {_M,VDef} ->
- resolv_value1(S,VDef)
- end
- end;
-resolv_value1(S, {gt,V}) ->
- case resolv_value1(S, V) of
- Int when is_integer(Int) ->
- Int + 1;
- Other ->
- throw({error,{asn1,{not_integer_value,Other}}})
- end;
-resolv_value1(S, {lt,V}) ->
- case resolv_value1(S, V) of
- Int when is_integer(Int) ->
- Int - 1;
- Other ->
- throw({error,{asn1,{not_integer_value,Other}}})
- end;
-resolv_value1(S,{'ValueFromObject',{object,Object},[{valuefieldreference,
- FieldName}]}) ->
- %% FieldName can hold either a fixed-type value or a variable-type value
- %% Object is a DefinedObject, i.e. a #'Externaltypereference'
- resolve_value_from_object(S,Object,FieldName);
-resolv_value1(_,#valuedef{checked=true,value=V}) ->
- V;
-resolv_value1(S,#valuedef{type=_T,
- value={'ValueFromObject',{object,Object},
- [{valuefieldreference,
- FieldName}]}}) ->
- resolve_value_from_object(S,Object,FieldName);
-resolv_value1(S,VDef = #valuedef{}) ->
- #valuedef{value=Val} = check_value(S,VDef),
- Val;
-resolv_value1(_,V) ->
- V.
-resolve_value_from_object(S,Object,FieldName) ->
- {_,ObjTDef} = get_referenced_type(S,Object),
- TS = check_object(S,ObjTDef,ObjTDef#typedef.typespec),
- {_,_,Components} = TS#'Object'.def,
- case lists:keysearch(FieldName,1,Components) of
- {value,{_,#valuedef{value=Val}}} ->
- Val;
- _ ->
- error({value,"illegal value in constraint",S})
+check_constraints(_S, _HostType, []) ->
+ [];
+check_constraints(S, HostType0, [_|_]=Cs0) ->
+ HostType = get_real_host_type(HostType0, Cs0),
+ Cs1 = top_level_intersections(Cs0),
+ Cs2 = [coalesce_constraints(C) || C <- Cs1],
+ {_,Cs3} = filter_extensions(Cs2),
+ Cs = simplify_element_sets(S, HostType, Cs3),
+ finish_constraints(Cs).
+
+get_real_host_type(HostType, Cs) ->
+ case lists:keyfind(ocft, 1, Cs) of
+ false -> HostType;
+ {_,OCFT} -> HostType#type{def=OCFT}
end.
+top_level_intersections([{element_set,{intersection,_,_}=C,none}]) ->
+ top_level_intersections_1(C);
+top_level_intersections(Cs) ->
+ Cs.
+
+top_level_intersections_1({intersection,A,B}) ->
+ [{element_set,A,none}|top_level_intersections_1(B)];
+top_level_intersections_1(Other) ->
+ [{element_set,Other,none}].
+
+coalesce_constraints({element_set,
+ {Tag,{element_set,A,_}},
+ {Tag,{element_set,B,_}}}) ->
+ %% (SIZE (C1), ..., (SIZE (C2)) => (SIZE (C1, ..., C2))
+ {element_set,{Tag,{element_set,A,B}},none};
+coalesce_constraints(Other) ->
+ Other.
+
+%% Remove all outermost extensions except the last.
+
+filter_extensions([H0|T0]) ->
+ case filter_extensions(T0) of
+ {true,T} ->
+ H = remove_extension(H0),
+ {true,[H|T]};
+ {false,T} ->
+ {any_extension(H0),[H0|T]}
+ end;
+filter_extensions([]) ->
+ {false,[]}.
-resolve_namednumber(S,#typedef{typespec=Type},Name) ->
- case Type#type.def of
- {'ENUMERATED',NameList} ->
- resolve_namednumber_1(S, Name, NameList, Type);
- {'INTEGER',NameList} ->
- resolve_namednumber_1(S, Name, NameList, Type);
+remove_extension({element_set,Root,_}) ->
+ {element_set,remove_extension(Root),none};
+remove_extension(Tuple) when is_tuple(Tuple) ->
+ L = [remove_extension(El) || El <- tuple_to_list(Tuple)],
+ list_to_tuple(L);
+remove_extension(Other) -> Other.
+
+any_extension({element_set,_,Ext}) when Ext =/= none ->
+ true;
+any_extension(Tuple) when is_tuple(Tuple) ->
+ any_extension_tuple(1, Tuple);
+any_extension(_) -> false.
+
+any_extension_tuple(I, T) when I =< tuple_size(T) ->
+ any_extension(element(I, T)) orelse any_extension_tuple(I+1, T);
+any_extension_tuple(_, _) -> false.
+
+simplify_element_sets(S, HostType, [{element_set,R0,E0}|T0]) ->
+ R1 = simplify_element_set(S, HostType, R0),
+ E1 = simplify_element_set(S, HostType, E0),
+ case simplify_element_sets(S, HostType, T0) of
+ [{element_set,R2,E2}] ->
+ [{element_set,cs_intersection(S, R1, R2),
+ cs_intersection(S, E1, E2)}];
+ L when is_list(L) ->
+ [{element_set,R1,E1}|L]
+ end;
+simplify_element_sets(S, HostType, [H|T]) ->
+ [H|simplify_element_sets(S, HostType, T)];
+simplify_element_sets(_, _, []) ->
+ [].
+
+simplify_element_set(_S, _HostType, empty) ->
+ {set,[]};
+simplify_element_set(S, HostType, {'SingleValue',Vs0}) when is_list(Vs0) ->
+ Vs1 = [resolve_value(S, HostType, V) || V <- Vs0],
+ Vs = make_constr_set_vs(Vs1),
+ simplify_element_set(S, HostType, Vs);
+simplify_element_set(S, HostType, {'SingleValue',V0}) ->
+ V1 = resolve_value(S, HostType, V0),
+ V = {set,[{range,V1,V1}]},
+ simplify_element_set(S, HostType, V);
+simplify_element_set(S, HostType, {'ValueRange',{Lb0,Ub0}}) ->
+ Lb = resolve_value(S, HostType, Lb0),
+ Ub = resolve_value(S, HostType, Ub0),
+ V = make_constr_set(S, Lb, Ub),
+ simplify_element_set(S, HostType, V);
+simplify_element_set(S, HostType, {'ALL-EXCEPT',Set0}) ->
+ Set = simplify_element_set(S, HostType, Set0),
+ {'ALL-EXCEPT',Set};
+simplify_element_set(S, HostType, {intersection,A0,B0}) ->
+ A = simplify_element_set(S, HostType, A0),
+ B = simplify_element_set(S, HostType, B0),
+ cs_intersection(S, A, B);
+simplify_element_set(S, HostType, {union,A0,B0}) ->
+ A = simplify_element_set(S, HostType, A0),
+ B = simplify_element_set(S, HostType, B0),
+ cs_union(S, A, B);
+simplify_element_set(S, HostType, {simpletable,{element_set,Type,_}}) ->
+ check_simpletable(S, HostType, Type);
+simplify_element_set(S, _, {componentrelation,R,Id}) ->
+ check_componentrelation(S, R, Id);
+simplify_element_set(S, HostType, {Tag,{element_set,_,_}=El0}) ->
+ [El1] = simplify_element_sets(S, HostType, [El0]),
+ {Tag,El1};
+simplify_element_set(S, HostType, #type{}=Type) ->
+ simplify_element_set_type(S, HostType, Type);
+simplify_element_set(_, _, C) ->
+ C.
+
+simplify_element_set_type(S, HostType, #type{def=Def0}=Type0) ->
+ #'Externaltypereference'{} = Def0, %Assertion.
+ case get_referenced_type(S, Def0) of
+ {_,#valuedef{checked=false,value={valueset,Vs0}}} ->
+ [Vs1] = simplify_element_sets(S, HostType, [Vs0]),
+ case Vs1 of
+ {element_set,Set,none} ->
+ Set;
+ {element_set,Set,{set,[]}} ->
+ Set
+ end;
+ {_,{valueset,#type{def=#'Externaltypereference'{}}=Type}} ->
+ simplify_element_set_type(S, HostType, Type);
_ ->
- not_enumerated
+ case HostType of
+ #type{def=#'ObjectClassFieldType'{}} ->
+ %% Open type.
+ #type{def=Def} = check_type(S, HostType, Type0),
+ Def;
+ _ ->
+ #type{constraint=Cs} = check_type(S, HostType, Type0),
+ C = convert_back(Cs),
+ simplify_element_set(S, HostType, C)
+ end
end.
-resolve_namednumber_1(S, Name, NameList, Type) ->
- NamedNumberList = check_enumerated(S, NameList, Type#type.constraint),
- {_,N} = lookup_enum_value(S, Name, NamedNumberList),
- N.
-
-check_constraints(S,[{'ContainedSubtype',Type} | Rest], Acc) ->
- {RefMod,CTDef} = get_referenced_type(S,Type#type.def),
- NewS = S#state{module=load_asn1_module(S,RefMod),mname=RefMod,
- type=CTDef,tname=get_datastr_name(CTDef)},
- CType = check_type(NewS,S#state.tname,CTDef#typedef.typespec),
- check_constraints(S,Rest,CType#type.constraint ++ Acc);
-check_constraints(S,[C | Rest], Acc) ->
- check_constraints(S,Rest,[check_constraint(S,C) | Acc]);
-check_constraints(S,[],Acc) ->
- constraint_merge(S,Acc).
-
-
-range_check(F={FixV,FixV}) ->
-% FixV;
- F;
-range_check(VR={Lb,Ub}) when Lb < Ub ->
- VR;
-range_check(Err={_,_}) ->
- throw({error,{asn1,{illegal_size_constraint,Err}}});
-range_check(Value) ->
- Value.
-
-check_constraint(S,Ext) when is_record(Ext,'Externaltypereference') ->
- check_externaltypereference(S,Ext);
-
-
-check_constraint(S,{'SizeConstraint',{Lb,Ub}})
- when is_list(Lb); tuple_size(Lb) =:= 2 ->
- NewLb = range_check(resolv_tuple_or_list(S,Lb)),
- NewUb = range_check(resolv_tuple_or_list(S,Ub)),
- {'SizeConstraint',{NewLb,NewUb}};
-check_constraint(S,{'SizeConstraint',{Lb,Ub}}) ->
- case {resolv_value(S,Lb),resolv_value(S,Ub)} of
- {FixV,FixV} ->
- {'SizeConstraint',FixV};
- {Low,High} when Low < High ->
- {'SizeConstraint',{Low,High}};
- Err ->
- throw({error,{asn1,{illegal_size_constraint,Err}}})
- end;
-check_constraint(S,{'SizeConstraint',Lb}) ->
- {'SizeConstraint',resolv_value(S,Lb)};
+convert_back([H1,H2|T]) ->
+ {intersection,H1,convert_back([H2|T])};
+convert_back([H]) ->
+ H;
+convert_back([]) ->
+ none.
-check_constraint(S,{'SingleValue', L}) when is_list(L) ->
- F = fun(A) -> resolv_value(S,A) end,
- {'SingleValue',lists:sort(lists:map(F,L))};
-
-check_constraint(S,{'SingleValue', V}) when is_integer(V) ->
- Val = resolv_value(S,V),
-%% [{'SingleValue',Val},{'ValueRange',{Val,Val}}]; % Why adding value range?
- {'SingleValue',Val};
-check_constraint(S,{'SingleValue', V}) ->
- {'SingleValue',resolv_value(S,V)};
-
-check_constraint(S,{'ValueRange', {Lb, Ub}}) ->
- {'ValueRange',{resolv_value(S,Lb),resolv_value(S,Ub)}};
-%% In case of a constraint with extension marks like (1..Ub,...)
-check_constraint(S,{VR={'ValueRange', {_Lb, _Ub}},Rest}) ->
- {check_constraint(S,VR),Rest};
-check_constraint(_S,{'PermittedAlphabet',PA}) ->
- {'PermittedAlphabet',permitted_alphabet_cnstr(PA)};
-
-check_constraint(S,{valueset,Type}) ->
- {valueset,check_type(S,S#state.tname,Type)};
-
-check_constraint(_S,ST={simpletable,Type}) when is_atom(Type) ->
- %% An already checked constraint
- ST;
-check_constraint(S,{simpletable,Type}) ->
+check_simpletable(S, HostType, Type) ->
+ case HostType of
+ #type{def=#'ObjectClassFieldType'{}} ->
+ ok;
+ _ ->
+ %% Table constraints may only be applied to
+ %% CLASS.&field constructs.
+ asn1_error(S, illegal_table_constraint)
+ end,
Def = case Type of
#type{def=D} -> D;
- {'SingleValue',ObjRef = #'Externalvaluereference'{}} ->
- ObjRef
+ {'SingleValue',#'Externalvaluereference'{}=ObjRef} ->
+ ObjRef;
+ _ ->
+ asn1_error(S, invalid_table_constraint)
end,
- C = match_parameters(S,Def,S#state.parameters),
+ C = match_parameter(S, Def),
case C of
#'Externaltypereference'{} ->
- ERef = check_externaltypereference(S,C),
- {simpletable,ERef#'Externaltypereference'.type};
- #type{def=#'Externaltypereference'{}=ExtTypeRef} ->
- ERef = check_externaltypereference(S, ExtTypeRef),
+ ERef = check_externaltypereference(S, C),
{simpletable,ERef#'Externaltypereference'.type};
- {valueset,#type{def=ERef=#'Externaltypereference'{}}} -> % this is an object set
- {_,TDef} = get_referenced_type(S,ERef),
- case TDef#typedef.typespec of
- #'ObjectSet'{} ->
- check_object(S,TDef,TDef#typedef.typespec),
- {simpletable,ERef#'Externaltypereference'.type};
- Err ->
- exit({error,{internal_error,Err}})
- end;
#'Externalvaluereference'{} ->
%% This is an object set with a referenced object
- {_,TorVDef} = get_referenced_type(S,C),
- GetObjectSet =
- fun(#typedef{typespec=O}) when is_record(O,'Object') ->
- #'ObjectSet'{class=O#'Object'.classname,
- set={'SingleValue',C}};
- (#valuedef{type=Cl,value=O})
- when is_record(O,'Externalvaluereference'),
- is_record(Cl,type) ->
- %% an object might reference another object
- #'ObjectSet'{class=Cl#type.def,
- set={'SingleValue',O}};
- (Err) ->
- exit({error,{internal_error,simpletable_constraint,Err}})
- end,
- ObjSet = GetObjectSet(TorVDef),
- {simpletable,check_object(S,Type,ObjSet)};
- #'ObjectSet'{} ->
- io:format("ALERT: simpletable forbidden case!~n",[]),
- {simpletable,check_object(S,Type,C)};
- {'ValueFromObject',{_,ORef},FieldName} ->
- %% This is an ObjectFromObject
- {_,Object} = get_referenced_type(S,ORef),
- ChObject = check_object(S,Object,
- Object#typedef.typespec),
- ObjFromObj=
- get_fieldname_element(S,Object#typedef{
- typespec=ChObject},
- FieldName),
- {simpletable,ObjFromObj};
-%% ObjFromObj#typedef{checked=true,typespec=
-%% check_object(S,ObjFromObj,
-%% ObjFromObj#typedef.typespec)}};
- _ ->
- check_type(S,S#state.tname,Type),%% this seems stupid.
- OSName = Def#'Externaltypereference'.type,
- {simpletable,OSName}
- end;
+ {_,TorVDef} = get_referenced_type(S, C),
+ Set = case TorVDef of
+ #typedef{typespec=#'Object'{classname=ClassName}} ->
+ #'ObjectSet'{class=ClassName,
+ set={'SingleValue',C}};
+ #valuedef{type=#type{def=ClassDef},
+ value=#'Externalvaluereference'{}=Obj} ->
+ %% an object might reference another object
+ #'ObjectSet'{class=ClassDef,
+ set={'SingleValue',Obj}}
+ end,
+ {simpletable,check_object(S, Type, Set)};
+ {'ValueFromObject',{_,Object},FieldNames} ->
+ %% This is an ObjectFromObject.
+ {simpletable,extract_field(S, Object, FieldNames)}
+ end.
-check_constraint(S,{componentrelation,{objectset,Opos,Objset},Id}) ->
+check_componentrelation(S, {objectset,Opos,Objset0}, Id) ->
%% Objset is an 'Externaltypereference' record, since Objset is
%% a DefinedObjectSet.
- RealObjset = match_parameters(S,Objset,S#state.parameters),
- ObjSetRef =
- case RealObjset of
- #'Externaltypereference'{} -> RealObjset;
- #type{def=#'Externaltypereference'{}} -> RealObjset#type.def;
- {valueset,OS = #type{def=#'Externaltypereference'{}}} -> OS#type.def
- end,
- Ext = check_externaltypereference(S,ObjSetRef),
- {componentrelation,{objectset,Opos,Ext},Id};
+ ObjSet = match_parameter(S, Objset0),
+ Ext = check_externaltypereference(S, ObjSet),
+ {componentrelation,{objectset,Opos,Ext},Id}.
+
+%%%
+%%% Internal set representation.
+%%%
+%%% We represent sets as a union of strictly disjoint ranges:
+%%%
+%%% {set,[Range]}
+%%%
+%%% A range is represented as:
+%%%
+%%% Range = {a_range,UpperBound} | {range,LowerBound,UpperBound}
+%%%
+%%% We don't use the atom 'MIN' to represent MIN, because atoms
+%%% compare higher than integer. Instead we use {a_range,UpperBound}
+%%% to represent MIN..UpperBound. We represent MAX as 'MAX' because
+%%% 'MAX' compares higher than any integer.
+%%%
+%%% The ranges are sorted in term order. The ranges must not overlap
+%%% or be adjacent to each other. This invariant is established when
+%%% creating sets, and maintained by the intersection and union
+%%% operators.
+%%%
+%%% Example of invalid set representaions:
+%%%
+%%% [{range,0,10},{range,5,10}] %Overlapping ranges
+%%% [{range,0,5},{range,6,10}] %Adjancent ranges
+%%% [{range,10,20},{a_range,100}] %Not sorted
+%%%
+
+make_constr_set(_, 'MIN', Ub) ->
+ {set,[{a_range,make_constr_set_val(Ub)}]};
+make_constr_set(_, Lb, Ub) when Lb =< Ub ->
+ {set,[{range,make_constr_set_val(Lb),
+ make_constr_set_val(Ub)}]};
+make_constr_set(S, _, _) ->
+ asn1_error(S, reversed_range).
+
+make_constr_set_val([C]) when is_integer(C) -> C;
+make_constr_set_val(Val) -> Val.
+
+make_constr_set_vs(Vs) ->
+ {set,make_constr_set_vs_1(Vs)}.
+
+make_constr_set_vs_1([]) ->
+ [];
+make_constr_set_vs_1([V]) ->
+ [{range,V,V}];
+make_constr_set_vs_1([V0|Vs]) ->
+ V1 = make_constr_set_vs_1(Vs),
+ range_union([{range,V0,V0}], V1).
+
+%%%
+%%% Set operators.
+%%%
+
+cs_intersection(_S, Other, none) ->
+ Other;
+cs_intersection(_S, none, Other) ->
+ Other;
+cs_intersection(_S, {set,SetA}, {set,SetB}) ->
+ {set,range_intersection(SetA, SetB)};
+cs_intersection(_S, A, B) ->
+ {intersection,A,B}.
+
+range_intersection([], []) ->
+ [];
+range_intersection([_|_], []) ->
+ [];
+range_intersection([], [_|_]) ->
+ [];
+range_intersection([H1|_]=A, [H2|_]=B) when H1 > H2 ->
+ range_intersection(B, A);
+range_intersection([H1|T1], [H2|T2]=B) ->
+ %% Now H1 =< H2.
+ case {H1,H2} of
+ {{a_range,Ub0},{a_range,Ub1}} when Ub0 < Ub1 ->
+ %% Ub0 =/= 'MAX'
+ [H1|range_intersection(T1, [{range,Ub0+1,Ub1}|T2])];
+ {{a_range,_},{a_range,_}} ->
+ %% Must be equal.
+ [H1|range_intersection(T1, T2)];
+ {{a_range,Ub0},{range,Lb1,_Ub1}} when Ub0 < Lb1 ->
+ %% No intersection.
+ range_intersection(T1, B);
+ {{a_range,Ub0},{range,Lb1,Ub1}} when Ub0 < Ub1 ->
+ %% Ub0 =/= 'MAX'
+ [{range,Lb1,Ub0}|range_intersection(T1, [{range,Ub0+1,Ub1}|T2])];
+ {{a_range,Ub},{range,_Lb1,Ub}} ->
+ %% The first range covers the second range, but does not
+ %% go beyond. We handle this case specially because Ub may
+ %% be 'MAX', and evaluating 'MAX'+1 will fail.
+ [H2|range_intersection(T1, T2)];
+ {{a_range,Ub0},{range,_Lb1,Ub1}} ->
+ %% Ub0 > Ub1, Ub1 =/= 'MAX'. The first range completely
+ %% covers and extends beyond the second range.
+ [H2|range_intersection([{range,Ub1+1,Ub0}|T1], T2)];
+ {{range,_Lb0,Ub0},{range,Lb1,_Ub1}} when Ub0 < Lb1 ->
+ %% Lb0 < Lb1. No intersection.
+ range_intersection(T1, B);
+ {{range,_Lb0,Ub0},{range,Lb1,Ub1}} when Ub0 < Ub1 ->
+ %% Ub0 >= Lb1, Ub0 =/= 'MAX'. Partial overlap.
+ [{range,Lb1,Ub0}|range_intersection(T1, [{range,Ub0+1,Ub1}|T2])];
+ {{range,_Lb0,Ub},{range,_Lb1,Ub}} ->
+ %% The first range covers the second range, but does not
+ %% go beyond. We handle this case specially because Ub may
+ %% be 'MAX', and evaluating 'MAX'+1 will fail.
+ [H2|range_intersection(T1, T2)];
+ {{range,_Lb0,Ub0},{range,_Lb1,Ub1}} ->
+ %% Ub1 =/= MAX. The first range completely covers and
+ %% extends beyond the second.
+ [H2|range_intersection([{range,Ub1+1,Ub0}|T1], T2)]
+ end.
-check_constraint(S,Type) when is_record(Type,type) ->
- #type{def=Def} = check_type(S,S#state.tname,Type),
- Def;
+cs_union(_S, {set,SetA}, {set,SetB}) ->
+ {set,range_union(SetA, SetB)};
+cs_union(_S, A, B) ->
+ {union,A,B}.
+
+range_union(A, B) ->
+ range_union_1(lists:merge(A, B)).
+
+range_union_1([{a_range,Ub0},{a_range,Ub1}|T]) ->
+ range_union_1([{a_range,max(Ub0, Ub1)}|T]);
+range_union_1([{a_range,Ub0},{range,Lb1,Ub1}|T]) when Lb1-1 =< Ub0 ->
+ range_union_1([{a_range,max(Ub0, Ub1)}|T]);
+range_union_1([{a_range,_}=H|T]) ->
+ %% Ranges are disjoint.
+ [H|range_union_1(T)];
+range_union_1([{range,Lb0,Ub0},{range,Lb1,Ub1}|T]) when Lb1-1 =< Ub0 ->
+ range_union_1([{range,Lb0,max(Ub0, Ub1)}|T]);
+range_union_1([{range,_,_}=H|T]) ->
+ %% Ranges are disjoint.
+ [H|range_union_1(T)];
+range_union_1([]) ->
+ [].
-check_constraint(S,C) when is_list(C) ->
- lists:map(fun(X)->check_constraint(S,X) end,C);
-% else keep the constraint unchanged
-check_constraint(_S,Any) ->
-% io:format("Constraint = ~p~n",[Any]),
- Any.
-
-permitted_alphabet_cnstr(T) when is_tuple(T) ->
- permitted_alphabet_cnstr([T]);
-permitted_alphabet_cnstr(L) when is_list(L) ->
- VRexpand = fun({'ValueRange',{A,B}}) ->
- {'SingleValue',expand_valuerange(A,B)};
- (Other) ->
- Other
- end,
- L2 = lists:map(VRexpand,L),
- %% first perform intersection
- L3 = permitted_alphabet_intersection(L2),
- [Res] = permitted_alphabet_union(L3),
- Res.
+%%%
+%%% Finish up constrains, making them suitable for the back-ends.
+%%%
+%%% A 'PermittedAlphabet' (FROM) constraint will be reduced to:
+%%%
+%%% {'SingleValue',[integer()]}
+%%%
+%%% A 'SizeConstraint' (SIZE) constraint will be reduced to:
+%%%
+%%% {Lb,Ub}
+%%%
+%%% All other constraints will be reduced to:
+%%%
+%%% {'SingleValue',[integer()]} | {'ValueRange',Lb,Ub}
+%%%
+
+finish_constraints(Cs) ->
+ finish_constraints_1(Cs, fun smart_collapse/1).
+
+finish_constraints_1([{element_set,{Tag,{element_set,_,_}=Set0},none}|T],
+ Collapse0) ->
+ Collapse = collapse_fun(Tag),
+ case finish_constraints_1([Set0], Collapse) of
+ [] ->
+ finish_constraints_1(T, Collapse0);
+ [Set] ->
+ [{Tag,Set}|finish_constraints_1(T, Collapse0)]
+ end;
+finish_constraints_1([{element_set,{set,[{a_range,'MAX'}]},_}|T], Collapse) ->
+ finish_constraints_1(T, Collapse);
+finish_constraints_1([{element_set,{intersection,A0,B0},none}|T], Collapse) ->
+ A = {element_set,A0,none},
+ B = {element_set,B0,none},
+ finish_constraints_1([A,B|T], Collapse);
+finish_constraints_1([{element_set,Root,Ext}|T], Collapse) ->
+ case finish_constraint(Root, Ext, Collapse) of
+ none ->
+ finish_constraints_1(T, Collapse);
+ Constr ->
+ [Constr|finish_constraints_1(T, Collapse)]
+ end;
+finish_constraints_1([H|T], Collapse) ->
+ [H|finish_constraints_1(T, Collapse)];
+finish_constraints_1([], _) ->
+ [].
-expand_valuerange([A],[A]) ->
- [A];
-expand_valuerange([A],[B]) when A < B ->
- [A|expand_valuerange([A+1],[B])].
+finish_constraint({set,Root0}, Ext, Collapse) ->
+ case Collapse(Root0) of
+ none -> none;
+ Root -> finish_constraint(Root, Ext, Collapse)
+ end;
+finish_constraint(Root, Ext, _Collapse) ->
+ case Ext of
+ none -> Root;
+ _ -> {Root,[]}
+ end.
-permitted_alphabet_intersection(C) ->
- permitted_alphabet_merge(C,intersection, []).
+collapse_fun('SizeConstraint') ->
+ fun size_constraint_collapse/1;
+collapse_fun('PermittedAlphabet') ->
+ fun single_value_collapse/1.
-permitted_alphabet_union(C) ->
- permitted_alphabet_merge(C,union, []).
+single_value_collapse(V) ->
+ {'SingleValue',ordsets:from_list(single_value_collapse_1(V))}.
-permitted_alphabet_merge([],_,Acc) ->
- lists:reverse(Acc);
-permitted_alphabet_merge([{'SingleValue',L1},
- UorI,
- {'SingleValue',L2}|Rest],UorI,Acc)
- when is_list(L1),is_list(L2) ->
- UI = ordsets:UorI([ordsets:from_list(L1),ordsets:from_list(L2)]),
- permitted_alphabet_merge([{'SingleValue',UI}|Rest],UorI,Acc);
-permitted_alphabet_merge([C1|Rest],UorI,Acc) ->
- permitted_alphabet_merge(Rest,UorI,[C1|Acc]).
-
-
-%% constraint_merge/2
-%% Compute the intersection of the outermost level of the constraint list.
-%% See Dubuisson second paragraph and fotnote on page 285.
-%% If constraints with extension are included in combined constraints. The
-%% resulting combination will have the extension of the last constraint. Thus,
-%% there will be no extension if the last constraint is without extension.
-%% The rootset of all constraints are considered in the "outermoust
-%% intersection". See section 13.1.2 in Dubuisson.
-constraint_merge(St, Cs0) ->
- Cs = constraint_merge_1(St, Cs0),
- normalize_cs(Cs).
-
-normalize_cs([{'SingleValue',[V]}|Cs]) ->
- [{'SingleValue',V}|normalize_cs(Cs)];
-normalize_cs([{'SingleValue',[_|_]=L0}|Cs]) ->
- [H|T] = L = lists:usort(L0),
- [case is_range(H, T) of
- false -> {'SingleValue',L};
- true -> {'ValueRange',{H,lists:last(T)}}
- end|normalize_cs(Cs)];
-normalize_cs([{'ValueRange',{Sv,Sv}}|Cs]) ->
- [{'SingleValue',Sv}|normalize_cs(Cs)];
-normalize_cs([{'ValueRange',{'MIN','MAX'}}|Cs]) ->
- normalize_cs(Cs);
-normalize_cs([{'SizeConstraint',C0}|Cs]) ->
- case normalize_size_constraint(C0) of
- none ->
- normalize_cs(Cs);
- C ->
- [{'SizeConstraint',C}|normalize_cs(Cs)]
- end;
-normalize_cs([H|T]) ->
- [H|normalize_cs(T)];
-normalize_cs([]) -> [].
+single_value_collapse_1([{range,Lb,Ub}|T]) when is_integer(Lb),
+ is_integer(Ub) ->
+ lists:seq(Lb, Ub) ++ single_value_collapse_1(T);
+single_value_collapse_1([]) ->
+ [].
-%% 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'}) ->
+smart_collapse([{a_range,Ub}]) ->
+ {'ValueRange',{'MIN',Ub}};
+smart_collapse([{a_range,_}|T]) ->
+ {range,_,Ub} = lists:last(T),
+ {'ValueRange',{'MIN',Ub}};
+smart_collapse([{range,Lb,Ub}]) ->
+ {'ValueRange',{Lb,Ub}};
+smart_collapse([_|_]=L) ->
+ V = lists:foldr(fun({range,Lb,Ub}, A) ->
+ seq(Lb, Ub) ++ A
+ end, [], L),
+ {'SingleValue',V}.
+
+size_constraint_collapse([{range,0,'MAX'}]) ->
none;
-normalize_size_constraint({Lb,Ub}=Range)
- when is_integer(Lb), is_integer(Ub) orelse Ub =:= 'MAX' ->
- Range.
+size_constraint_collapse(Root) ->
+ [{range,Lb,_}|_] = Root,
+ {range,_,Ub} = lists:last(Root),
+ {Lb,Ub}.
-is_range(Prev, [H|T]) when Prev =:= H - 1 -> is_range(H, T);
-is_range(_, [_|_]) -> false;
-is_range(_, []) -> true.
+seq(Same, Same) ->
+ [Same];
+seq(Lb, Ub) when is_integer(Lb), is_integer(Ub) ->
+ lists:seq(Lb, Ub).
-constraint_merge_1(_S, [H]=C) when is_tuple(H) ->
- C;
-constraint_merge_1(_S, []) ->
- [];
-constraint_merge_1(S, C) ->
- %% skip all extension but the last extension
- C1 = filter_extensions(C),
- %% perform all internal level intersections, intersections first
- %% since they have precedence over unions
- C2 = lists:map(fun(X)when is_list(X)->constraint_intersection(S,X);
- (X) -> X end,
- C1),
- %% perform all internal level unions
- C3 = lists:map(fun(X)when is_list(X)->constraint_union(S,X);
- (X) -> X end,
- C2),
-
- %% now get intersection of the outermost level
- %% get the least common single value constraint
- SVs = get_constraints(C3,'SingleValue'),
- CombSV = intersection_of_sv(S,SVs),
- %% get the least common value range constraint
- VRs = get_constraints(C3,'ValueRange'),
- CombVR = intersection_of_vr(S,VRs),
- %% get the least common size constraint
- SZs = get_constraints(C3,'SizeConstraint'),
- CombSZ = intersection_of_size(S,SZs),
- RestC = ordsets:subtract(ordsets:from_list(C3),
- ordsets:from_list(SZs ++ VRs ++ SVs)),
- %% get the least common combined constraint. That is the union of each
- %% deep constraint and merge of single value and value range constraints.
- %% FIXME: Removing 'intersection' from the flattened list essentially
- %% means that intersections are converted to unions!
- Cs = combine_constraints(S, CombSV, CombVR, CombSZ++RestC),
- [X || X <- lists:flatten(Cs),
- X =/= intersection,
- X =/= union].
-
-%% constraint_union(S,C) takes a list of constraints as input and
-%% merge them to a union. Unions are performed when two
-%% constraints is found with an atom union between.
-%% The list may be nested. Fix that later !!!
-constraint_union(_S,[]) ->
- [];
-constraint_union(_S,C=[_E]) ->
- C;
-constraint_union(S,C) when is_list(C) ->
- case lists:member(union,C) of
- true ->
- constraint_union1(S,C,[]);
- _ ->
- C
- end;
-% SV = get_constraints(C,'SingleValue'),
-% SV1 = constraint_union_sv(S,SV),
-% VR = get_constraints(C,'ValueRange'),
-% VR1 = constraint_union_vr(VR),
-% RestC = ordsets:filter(fun({'SingleValue',_})->false;
-% ({'ValueRange',_})->false;
-% (_) -> true end,ordsets:from_list(C)),
-% SV1++VR1++RestC;
-constraint_union(_S,C) ->
- [C].
-
-constraint_union1(S, [{'ValueRange',{Lb1,Ub1}},union,
- {'ValueRange',{Lb2,Ub2}}|Rest], Acc) ->
- AunionB = {'ValueRange',{c_min(Lb1, Lb2),max(Ub1, Ub2)}},
- constraint_union1(S, [AunionB|Rest], Acc);
-constraint_union1(S,[A={'SingleValue',_},union,B={'SingleValue',_}|Rest],Acc) ->
- AunionB = constraint_union_sv(S,[A,B]),
- constraint_union1(S,Rest,Acc ++ AunionB);
-constraint_union1(S,[A={'SingleValue',_},union,B={'ValueRange',_}|Rest],Acc) ->
- AunionB = union_sv_vr(S,A,B),
- constraint_union1(S, AunionB++Rest, Acc);
-constraint_union1(S,[A={'ValueRange',_},union,B={'SingleValue',_}|Rest],Acc) ->
- AunionB = union_sv_vr(S,B,A),
- constraint_union1(S, AunionB++Rest, Acc);
-constraint_union1(S,[union|Rest],Acc) -> %skip when unsupported constraints
- constraint_union1(S,Rest,Acc);
-constraint_union1(S,[A|Rest],Acc) ->
- constraint_union1(S,Rest,[A|Acc]);
-constraint_union1(_S,[],Acc) ->
- Acc.
+%%%-----------------------------------------
+%% If the constraint value is a defined value the valuename
+%% is replaced by the actual value
+%%
+resolve_value(S, HostType, Val) ->
+ Id = match_parameter(S, Val),
+ resolve_value1(S, HostType, Id).
-constraint_union_sv(_S,SV) ->
- Values=lists:map(fun({_,V})->V end,SV),
- case ordsets:from_list(Values) of
- [] -> [];
- [N] -> [{'SingleValue',N}];
- L -> [{'SingleValue',L}]
- end.
-c_min('MIN', _) -> 'MIN';
-c_min(_, 'MIN') -> 'MIN';
-c_min(A, B) -> min(A, B).
-
-union_sv_vr(_S,{'SingleValue',SV},VR)
- when is_integer(SV) ->
- union_sv_vr(_S,{'SingleValue',[SV]},VR);
-union_sv_vr(_S,{'SingleValue',SV},{'ValueRange',{VLb,VUb}})
- when is_list(SV) ->
- L = lists:sort(SV++[VLb,VUb]),
- {Lb,L1} = case lists:member('MIN',L) of
- true -> {'MIN',L--['MIN']}; % remove 'MIN' so it does not disturb
- false -> {hd(L),tl(L)}
- end,
- Ub = case lists:member('MAX',L1) of
- true -> 'MAX';
- false -> lists:last(L1)
- end,
- case SV of
- [H] -> H;
- _ -> SV
- end,
- %% for now we through away the Singlevalues so that they don't disturb
- %% in the code generating phase (the effective Valuerange is already
- %% calculated. If we want to keep the Singlevalues as well for
- %% use in code gen phases we need to introduce a new representation
- %% like {'ValueRange',{Lb,Ub},[ListOfRanges|AntiValues|Singlevalues]
- %% These could be used to generate guards which allows only the specific
- %% values , not the full range
- [{'ValueRange',{Lb,Ub}}].
-
-
-%% get_constraints/2
-%% Arguments are a list of constraints, which has the format {key,value},
-%% and a constraint type
-%% Returns a list of constraints only of the requested type or the atom
-%% 'no' if no such constraints were found
-get_constraints(L=[{CType,_}],CType) ->
- L;
-get_constraints(C,CType) ->
- keysearch_allwithkey(CType,1,C).
-
-%% keysearch_allwithkey(Key,Ix,L)
-%% Types:
-%% Key = is_atom()
-%% Ix = integer()
-%% L = [TwoTuple]
-%% TwoTuple = [{atom(),term()}|...]
-%% Returns a List that contains all
-%% elements from L that has a key Key as element Ix
-keysearch_allwithkey(Key,Ix,L) ->
- lists:filter(fun(X) when is_tuple(X) ->
- case element(Ix,X) of
- Key -> true;
- _ -> false
- end;
- (_) -> false
- end, L).
-
-
-%% filter_extensions(C)
-%% takes a list of constraints as input and returns a list with the
-%% constraints and all extensions but the last are removed.
-filter_extensions([L]) when is_list(L) ->
- [filter_extensions(L)];
-filter_extensions(C=[_H]) ->
- C;
-filter_extensions(C) when is_list(C) ->
- filter_extensions(C,[], []).
-
-filter_extensions([],Acc,[]) ->
- Acc;
-filter_extensions([],Acc,[EC|ExtAcc]) ->
- CwoExt = remove_extension(ExtAcc,[]),
- CwoExt ++ [EC|Acc];
-filter_extensions([C={A,_E}|T],Acc,ExtAcc) when is_tuple(A) ->
- filter_extensions(T,Acc,[C|ExtAcc]);
-filter_extensions([C={'SizeConstraint',{A,_B}}|T],Acc,ExtAcc)
- when is_list(A);is_tuple(A) ->
- filter_extensions(T,Acc,[C|ExtAcc]);
-filter_extensions([C={'PermittedAlphabet',{{'SingleValue',_},E}}|T],Acc,ExtAcc)
- when is_tuple(E); is_list(E) ->
- filter_extensions(T,Acc,[C|ExtAcc]);
-filter_extensions([H|T],Acc,ExtAcc) ->
- filter_extensions(T,[H|Acc],ExtAcc).
-
-remove_extension([],Acc) ->
- Acc;
-remove_extension([{'SizeConstraint',{A,_B}}|R],Acc) ->
- remove_extension(R,[{'SizeConstraint',A}|Acc]);
-remove_extension([{C,_E}|R],Acc) when is_tuple(C) ->
- remove_extension(R,[C|Acc]);
-remove_extension([{'PermittedAlphabet',{A={'SingleValue',_},
- E}}|R],Acc)
- when is_tuple(E);is_list(E) ->
- remove_extension(R,[{'PermittedAlphabet',A}|Acc]).
-
-%% constraint_intersection(S,C) takes a list of constraints as input and
-%% performs intersections. Intersecions are performed when an
-%% atom intersection is found between two constraints.
-%% The list may be nested. Fix that later !!!
-constraint_intersection(_S,[]) ->
- [];
-constraint_intersection(_S,C=[_E]) ->
- C;
-constraint_intersection(S,C) when is_list(C) ->
-% io:format("constraint_intersection: ~p~n",[C]),
- case lists:member(intersection,C) of
- true ->
- constraint_intersection1(S,C,[]);
- _ ->
- C
+resolve_value1(S, HostType, #'Externalvaluereference'{value=Name}=ERef) ->
+ case resolve_namednumber(S, HostType, Name) of
+ V when is_integer(V) ->
+ V;
+ not_named ->
+ resolve_value1(S, HostType, get_referenced_value(S, ERef))
end;
-constraint_intersection(_S,C) ->
- [C].
-
-constraint_intersection1(S,[A,intersection,B|Rest],Acc) ->
- AisecB = c_intersect(S,A,B),
- constraint_intersection1(S, AisecB++Rest, Acc);
-constraint_intersection1(S,[A|Rest],Acc) ->
- constraint_intersection1(S,Rest,[A|Acc]);
-constraint_intersection1(_, [], [C]) ->
- C;
-constraint_intersection1(_,[],Acc) ->
- lists:reverse(Acc).
-
-c_intersect(S,C1={'SingleValue',_},C2={'SingleValue',_}) ->
- intersection_of_sv(S,[C1,C2]);
-c_intersect(S,C1={'ValueRange',_},C2={'ValueRange',_}) ->
- intersection_of_vr(S,[C1,C2]);
-c_intersect(S,C1={'ValueRange',_},C2={'SingleValue',_}) ->
- intersection_sv_vr(S,[C2],[C1]);
-c_intersect(S,C1={'SingleValue',_},C2={'ValueRange',_}) ->
- intersection_sv_vr(S,[C1],[C2]);
-c_intersect(_S,C1,C2) ->
- [C1,C2].
-
-%% combine_constraints(S,SV,VR,CComb)
-%% Types:
-%% S = is_record(state,S)
-%% SV = [] | [SVC]
-%% VR = [] | [VRC]
-%% CComb = [] | [Lists]
-%% SVC = {'SingleValue',integer()} | {'SingleValue',[integer(),...]}
-%% VRC = {'ValueRange',{Lb,Ub}}
-%% Lists = List of lists containing any constraint combination
-%% Lb = 'MIN' | integer()
-%% Ub = 'MAX' | integer()
-%% Returns a combination of the least common constraint among SV,VR and all
-%% elements in CComb
-combine_constraints(_S,[],VR,CComb) ->
- VR ++ CComb;
-% combine_combined_cnstr(S,VR,CComb);
-combine_constraints(_S,SV,[],CComb) ->
- SV ++ CComb;
-% combine_combined_cnstr(S,SV,CComb);
-combine_constraints(S,SV,VR,CComb) ->
- C=intersection_sv_vr(S,SV,VR),
- C ++ CComb.
-% combine_combined_cnstr(S,C,CComb).
-
-intersection_sv_vr(_S,[C1={'SingleValue',SV}],[C2={'ValueRange',{_Lb,_Ub}}])
- when is_integer(SV) ->
- case is_int_in_vr(SV,C2) of
- true -> [C1];
- _ -> %%error({type,{"asn1 illegal constraint",C1,C2},S})
- %throw({error,{"asn1 illegal constraint",C1,C2}})
- %io:format("warning: could not analyze constraint ~p~n",[[C1,C2]]),
- [C1,C2]
+resolve_value1(S, HostType, {gt,V}) ->
+ case resolve_value1(S, HostType, V) of
+ Int when is_integer(Int) ->
+ Int + 1;
+ _Other ->
+ asn1_error(S, illegal_integer_value)
end;
-intersection_sv_vr(_S,[C1={'SingleValue',SV}],[C2])
- when is_list(SV) ->
- case lists:filter(fun(X)->is_int_in_vr(X,C2) end,SV) of
- [] ->
- %%error({type,{"asn1 illegal constraint",C1,C2},S});
- %throw({error,{"asn1 illegal constraint",C1,C2}});
- %io:format("warning: could not analyze constraint ~p~n",[[C1,C2]]),
- [C1,C2];
- [V] -> [{'SingleValue',V}];
- L -> [{'SingleValue',L}]
- end.
-
-
-%% Size constraint [{'SizeConstraint',1},{'SizeConstraint',{{1,64},[]}}]
-
-intersection_of_size(_,[]) ->
- [];
-intersection_of_size(_,C=[_SZ]) ->
- C;
-intersection_of_size(S,[SZ,SZ|Rest]) ->
- intersection_of_size(S,[SZ|Rest]);
-intersection_of_size(S,C=[C1={_,Int},{_,Range}|Rest])
- when is_integer(Int),is_tuple(Range) ->
- case Range of
- {Lb,Ub} when Int >= Lb,
- Int =< Ub ->
- intersection_of_size(S,[C1|Rest]);
- {{Lb,Ub},Ext} when is_list(Ext),Int >= Lb,Int =< Ub ->
- intersection_of_size(S,[C1|Rest]);
- _ ->
- throw({error,{asn1,{illegal_size_constraint,C}}})
+resolve_value1(S, HostType, {lt,V}) ->
+ case resolve_value1(S, HostType, V) of
+ Int when is_integer(Int) ->
+ Int - 1;
+ _Other ->
+ asn1_error(S, illegal_integer_value)
end;
-intersection_of_size(S,[C1={_,Range},C2={_,Int}|Rest])
- when is_integer(Int),is_tuple(Range) ->
- intersection_of_size(S,[C2,C1|Rest]);
-intersection_of_size(S,[{_,{Lb1,Ub1}},{_,{Lb2,Ub2}}|Rest]) ->
- Lb=greatest_LB(ordsets:from_list([Lb1,Lb2])),
- Ub=smallest_UB(ordsets:from_list([Ub1,Ub2])),
- intersection_of_size(S,[{'SizeConstraint',{Lb,Ub}}|Rest]);
-intersection_of_size(_,SZ) ->
- throw({error,{asn1,{illegal_size_constraint,SZ}}}).
-
-intersection_of_vr(_,[]) ->
- [];
-intersection_of_vr(_,VR=[_C]) ->
- VR;
-intersection_of_vr(S,[{_,{Lb1,Ub1}},{_,{Lb2,Ub2}}|Rest]) ->
- Lb=greatest_LB(ordsets:from_list([Lb1,Lb2])),
- Ub=smallest_UB(ordsets:from_list([Ub1,Ub2])),
- intersection_of_vr(S,[{'ValueRange',{Lb,Ub}}|Rest]);
-intersection_of_vr(_S,VR) ->
- %%error({type,{asn1,{illegal_value_range_constraint,VR}},S});
- throw({error,{asn1,{illegal_value_range_constraint,VR}}}).
-
-intersection_of_sv(_,[]) ->
- [];
-intersection_of_sv(_,SV=[_C]) ->
- SV;
-intersection_of_sv(S,[SV,SV|Rest]) ->
- intersection_of_sv(S,[SV|Rest]);
-intersection_of_sv(S,[{_,Int},{_,SV}|Rest]) when is_integer(Int),
- is_list(SV) ->
- SV2=intersection_of_sv1(S,Int,SV),
- intersection_of_sv(S,[SV2|Rest]);
-intersection_of_sv(S,[{_,SV},{_,Int}|Rest]) when is_integer(Int),
- is_list(SV) ->
- SV2=intersection_of_sv1(S,Int,SV),
- intersection_of_sv(S,[SV2|Rest]);
-intersection_of_sv(S,[{_,SV1},{_,SV2}|Rest]) when is_list(SV1),
- is_list(SV2) ->
- SV3=common_set(SV1,SV2),
- intersection_of_sv(S,[SV3|Rest]);
-intersection_of_sv(_S,SV) ->
- %%error({type,{asn1,{illegal_single_value_constraint,SV}},S}).
- throw({error,{asn1,{illegal_single_value_constraint,SV}}}).
-
-intersection_of_sv1(_S,Int,SV) when is_integer(Int),is_list(SV) ->
- case lists:member(Int,SV) of
- true -> {'SingleValue',Int};
+resolve_value1(S, _HostType, {'ValueFromObject',{object,Object},FieldName}) ->
+ get_value_from_object(S, Object, FieldName);
+resolve_value1(_, _, #valuedef{checked=true,value=V}) ->
+ V;
+resolve_value1(S, _, #valuedef{value={'ValueFromObject',
+ {object,Object},FieldName}}) ->
+ get_value_from_object(S, Object, FieldName);
+resolve_value1(S, _HostType, #valuedef{}=VDef) ->
+ #valuedef{value=Val} = check_value(S,VDef),
+ Val;
+resolve_value1(_, _, V) ->
+ V.
+
+resolve_namednumber(S, #type{def=Def}, Name) ->
+ case Def of
+ {'ENUMERATED',NameList} ->
+ resolve_namednumber_1(S, Name, NameList);
+ {'INTEGER',NameList} ->
+ resolve_namednumber_1(S, Name, NameList);
_ ->
- %%error({type,{asn1,{illegal_single_value_constraint,Int,SV}},S})
- throw({error,{asn1,{illegal_single_value_constraint,Int,SV}}})
- end;
-intersection_of_sv1(_S,SV1,SV2) ->
- %%error({type,{asn1,{illegal_single_value_constraint,SV1,SV2}},S}).
- throw({error,{asn1,{illegal_single_value_constraint,SV1,SV2}}}).
+ not_named
+ end.
-greatest_LB([H]) ->
- H;
-greatest_LB(L) ->
- greatest_LB1(lists:reverse(L)).
-greatest_LB1(['MIN',H2|_T])->
- H2;
-greatest_LB1([H|_T]) ->
- H.
-smallest_UB(L) ->
- hd(L).
-
-common_set(SV1,SV2) ->
- lists:filter(fun(X)->lists:member(X,SV1) end,SV2).
-
-is_int_in_vr(Int,{_,{'MIN','MAX'}}) when is_integer(Int) ->
- true;
-is_int_in_vr(Int,{_,{'MIN',Ub}}) when is_integer(Int),Int =< Ub ->
- true;
-is_int_in_vr(Int,{_,{Lb,'MAX'}}) when is_integer(Int),Int >= Lb ->
- true;
-is_int_in_vr(Int,{_,{Lb,Ub}}) when is_integer(Int),Int >= Lb,Int =< Ub ->
- true;
-is_int_in_vr(_,_) ->
- false.
-
+resolve_namednumber_1(S, Name, NameList) ->
+ try
+ NamedNumberList = check_enumerated(S, NameList),
+ {_,N} = lookup_enum_value(S, Name, NamedNumberList),
+ N
+ catch _:_ ->
+ not_named
+ end.
+
+%%%
+%%% End of constraint handling.
+%%%
check_imported(S,Imodule,Name) ->
check_imported(S,Imodule,Name,false).
@@ -4510,18 +3757,28 @@ check_reference(S,#'Externaltypereference'{pos=Pos,module=Emod,type=Name}) ->
#'Externaltypereference'{pos=Pos,module=ModName,type=Name}
end.
+get_referenced_value(S, T) ->
+ case get_referenced_type(S, T) of
+ {ExtMod,#valuedef{value=#'Externalvaluereference'{}=Ref}} ->
+ get_referenced_value(update_state(S, ExtMod), Ref);
+ {_,#valuedef{value=Val}} ->
+ Val
+ end.
+
get_referenced_type(S, T) ->
+ get_referenced_type(S, T, false).
+
+get_referenced_type(S, T, Recurse) ->
case do_get_referenced_type(S, T) of
- {_,#type{def=#'Externaltypereference'{}=ERef}} ->
- get_referenced_type(S, ERef);
- {_,#type{def=#'Externalvaluereference'{}=VRef}} ->
- get_referenced_type(S, VRef);
+ {_,#typedef{typespec=#type{def=#'Externaltypereference'{}=ERef}}}
+ when Recurse ->
+ get_referenced_type(S, ERef, Recurse);
{_,_}=Res ->
Res
end.
-do_get_referenced_type(#state{parameters=Ps}=S, T0) ->
- case match_parameters(S, T0, Ps) of
+do_get_referenced_type(S, T0) ->
+ case match_parameter(S, T0) of
T0 ->
do_get_ref_type_1(S, T0);
T ->
@@ -4563,7 +3820,7 @@ get_referenced(S,Emod,Ename,Pos) ->
%% May be an imported entity in module Emod or Emod may not exist
case asn1_db:dbget(Emod,'MODULE') of
undefined ->
- throw({error,{asn1,{module_not_found,Emod}}});
+ asn1_error(S, {undefined_import, Ename, Emod});
_ ->
NewS = update_state(S,Emod),
get_imported(NewS,Ename,Emod,Pos)
@@ -4593,12 +3850,11 @@ get_imported(S,Name,Module,Pos) ->
parse_and_save(S,Imodule),
case asn1_db:dbget(Imodule,'MODULE') of
undefined ->
- throw({error,{asn1,{module_not_found,Imodule}}});
+ asn1_error(S, {undefined_import, Name, Module});
Im when is_record(Im,module) ->
case is_exported(Im,Name) of
false ->
- throw({error,
- {asn1,{not_exported,{Im,Name}}}});
+ asn1_error(S, {undefined_export, Name});
_ ->
?dbg("get_imported, is_exported ~p, ~p~n",[Imodule,Name]),
get_referenced_type(S,
@@ -4611,37 +3867,6 @@ get_imported(S,Name,Module,Pos) ->
get_renamed_reference(S,Name,Module)
end.
-check_and_save(S,#'Externaltypereference'{module=M}=ERef,#typedef{checked=false}=TDef,Settings)
- when S#state.mname /= M ->
- %% This ERef is an imported type (or maybe a set.asn compilation)
- NewS = S#state{mname=M,module=load_asn1_module(S,M),
- type=TDef,tname=get_datastr_name(TDef)},
- Type=check_type(NewS,TDef,TDef#typedef.typespec),%XXX
- CheckedTDef = TDef#typedef{checked=true,
- typespec=Type},
- asn1_db:dbput(M,get_datastr_name(TDef),CheckedTDef),
- {merged_name(S,ERef),Settings};
-check_and_save(S,#'Externaltypereference'{module=M,type=N}=Eref,
- #ptypedef{name=Name,args=Params} = PTDef,Settings) ->
- %% instantiate a parameterized type
- %% The parameterized type should be saved as a type in the module
- %% it was instantiated.
- NewS = S#state{mname=M,module=load_asn1_module(S,M),
- type=PTDef,tname=Name},
- {Args,RestSettings} = lists:split(length(Params),Settings),
- Type = check_type(NewS,PTDef,#type{def={pt,Eref,Args}}),
- ERefName = new_reference_name(N),
- ERefNew = #'Externaltypereference'{type=ERefName,module=S#state.mname},
- NewTDef=#typedef{checked=true,name=ERefName,
- typespec=Type},
- insert_once(S,parameterized_objects,{ERefName,type,NewTDef}),
- asn1_db:dbput(S#state.mname,ERefNew#'Externaltypereference'.type,
- NewTDef),
- {ERefNew,RestSettings};
-check_and_save(_S,ERef,TDef,Settings) ->
- %% This might be a renamed type in a set of specs, so rename the ERef
- {ERef#'Externaltypereference'{type=asn1ct:get_name_of_def(TDef)},Settings}.
-
save_object_set_instance(S,Name,ObjSetSpec)
when is_record(ObjSetSpec,'ObjectSet') ->
NewObjSet = #typedef{checked=true,name=Name,typespec=ObjSetSpec},
@@ -4708,18 +3933,14 @@ update_state(S,ModuleName) ->
S;
_ ->
parse_and_save(S,ModuleName),
- case asn1_db:dbget(ModuleName,'MODULE') of
- RefedMod when is_record(RefedMod,module) ->
- S#state{mname=ModuleName,module=RefedMod};
- _ -> throw({error,{asn1,{module_does_not_exist,ModuleName}}})
- end
+ Mod = #module{} = asn1_db:dbget(ModuleName,'MODULE'),
+ S#state{mname=ModuleName,module=Mod}
end.
-
get_renamed_reference(S,Name,Module) ->
case renamed_reference(S,Name,Module) of
undefined ->
- throw({error,{asn1,{undefined_type,Name}}});
+ asn1_error(S, {undefined, Name});
NewTypeName when NewTypeName =/= Name ->
get_referenced1(S,Module,NewTypeName,undefined)
end.
@@ -4770,37 +3991,49 @@ get_importmoduleoftype([I|Is],Name) ->
get_importmoduleoftype([],_) ->
undefined.
+match_parameters(S, Names) ->
+ [match_parameter(S, Name) || Name <- Names].
-match_parameters(_S,Name,[]) ->
- Name;
+match_parameter(#state{parameters=Ps}=S, Name) ->
+ match_parameter(S, Name, Ps).
-match_parameters(_S,#'Externaltypereference'{type=Name},[{#'Externaltypereference'{type=Name},NewName}|_T]) ->
+match_parameter(_S, Name, []) ->
+ Name;
+match_parameter(S, {valueset,{element_set,#type{}=Ts,none}}, Ps) ->
+ match_parameter(S, {valueset,Ts}, Ps);
+match_parameter(_S, #'Externaltypereference'{type=Name},
+ [{#'Externaltypereference'{type=Name},NewName}|_T]) ->
NewName;
-match_parameters(_S,#'Externaltypereference'{type=Name},[{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) ->
+match_parameter(_S, #'Externaltypereference'{type=Name},
+ [{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) ->
NewName;
-match_parameters(_S,#'Externalvaluereference'{value=Name},[{#'Externalvaluereference'{value=Name},NewName}|_T]) ->
+match_parameter(_S, #'Externalvaluereference'{value=Name},
+ [{#'Externalvaluereference'{value=Name},NewName}|_T]) ->
NewName;
-match_parameters(_S,#'Externalvaluereference'{value=Name},[{{_,#'Externalvaluereference'{value=Name}},NewName}|_T]) ->
+match_parameter(_S, #'Externalvaluereference'{value=Name},
+ [{{_,#'Externalvaluereference'{value=Name}},NewName}|_T]) ->
NewName;
-match_parameters(_S,#type{def=#'Externaltypereference'{module=M,type=Name}},
- [{#'Externaltypereference'{module=M,type=Name},Type}]) ->
+match_parameter(_S, #type{def=#'Externaltypereference'{module=M,type=Name}},
+ [{#'Externaltypereference'{module=M,type=Name},Type}]) ->
Type;
-match_parameters(_S,{valueset,#type{def=#'Externaltypereference'{type=Name}}},
- [{{_,#'Externaltypereference'{type=Name}},{valueset,#type{def=NewName}}}|_T]) ->
+match_parameter(_S, {valueset,#type{def=#'Externaltypereference'{type=Name}}},
+ [{{_,#'Externaltypereference'{type=Name}},
+ {valueset,#type{def=NewName}}}|_T]) ->
NewName;
-match_parameters(_S,{valueset,#type{def=#'Externaltypereference'{type=Name}}},
- [{{_,#'Externaltypereference'{type=Name}},
- NewName=#type{def=#'Externaltypereference'{}}}|_T]) ->
+match_parameter(_S, {valueset,#type{def=#'Externaltypereference'{type=Name}}},
+ [{{_,#'Externaltypereference'{type=Name}},
+ NewName=#type{def=#'Externaltypereference'{}}}|_T]) ->
NewName#type.def;
-match_parameters(_S,{valueset,#type{def=#'Externaltypereference'{type=Name}}},
- [{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) ->
+match_parameter(_S, {valueset,#type{def=#'Externaltypereference'{type=Name}}},
+ [{{_,#'Externaltypereference'{type=Name}},NewName}|_T]) ->
NewName;
%% When a parameter is a parameterized element it has to be
%% instantiated now!
-match_parameters(S,{valueset,T=#type{def={pt,_,_Args}}},_Parameters) ->
- case catch check_type(S,#typedef{name=S#state.tname,typespec=T},T) of
- pobjectsetdef ->
-
+match_parameter(S, {valueset,T=#type{def={pt,_,_Args}}}, _Ps) ->
+ try check_type(S,#typedef{name=S#state.tname,typespec=T},T) of
+ #type{def=Ts} ->
+ Ts
+ catch pobjectsetdef ->
{_,ObjRef,_Params} = T#type.def,
{_,ObjDef}=get_referenced_type(S,ObjRef),
%%ObjDef is a pvaluesetdef where the type field holds the class
@@ -4818,17 +4051,15 @@ match_parameters(S,{valueset,T=#type{def={pt,_,_Args}}},_Parameters) ->
ObjectSet = #'ObjectSet'{class=RightClassRef,set=T},
ObjSpec = check_object(S,#typedef{typespec=ObjectSet},ObjectSet),
Name = list_to_atom(asn1ct_gen:list2name([get_datastr_name(ObjDef)|S#state.recordtopname])),
- save_object_set_instance(S,Name,ObjSpec);
- pvaluesetdef -> error({pvaluesetdef,"parameterized valueset",S});
- {error,_Reason} -> error({type,"error in parameter",S});
- Ts when is_record(Ts,type) -> Ts#type.def
+ save_object_set_instance(S,Name,ObjSpec)
end;
+
%% same as previous, only depends on order of parsing
-match_parameters(S,{valueset,{pos,{objectset,_,POSref},Args}},Parameters) ->
- match_parameters(S,{valueset,#type{def={pt,POSref,Args}}},Parameters);
-match_parameters(S,Name, [_H|T]) ->
- %%io:format("match_parameters(~p,~p)~n",[Name,[H|T]]),
- match_parameters(S,Name,T).
+match_parameter(S, {valueset,{pos,{objectset,_,POSref},Args}}, Ps) ->
+ match_parameter(S, {valueset,#type{def={pt,POSref,Args}}}, Ps);
+match_parameter(S, Name, [_H|T]) ->
+ %%io:format("match_parameter(~p,~p)~n",[Name,[H|T]]),
+ match_parameter(S, Name, T).
imported(S,Name) ->
{imports,Ilist} = (S#state.module)#module.imports,
@@ -4854,7 +4085,6 @@ check_named_number_list(_S, [{_,_}|_]=NNL) ->
NNL;
check_named_number_list(S, NNL0) ->
%% Check that the names are unique.
- T = S#state.type,
case check_unique(NNL0, 2) of
[] ->
NNL1 = [{Id,resolve_valueref(S, Val)} || {'NamedNumber',Id,Val} <- NNL0],
@@ -4863,14 +4093,14 @@ check_named_number_list(S, NNL0) ->
[] ->
NNL;
[Val|_] ->
- asn1_error(S, T, {value_reused,Val})
+ asn1_error(S, {value_reused,Val})
end;
[H|_] ->
- asn1_error(S, T, {namelist_redefinition,H})
+ asn1_error(S, {namelist_redefinition,H})
end.
-resolve_valueref(S, #'Externalvaluereference'{module=Mod,value=Name}) ->
- dbget_ex(S, Mod, Name);
+resolve_valueref(S, #'Externalvaluereference'{} = T) ->
+ get_referenced_value(S, T);
resolve_valueref(_, Val) when is_integer(Val) ->
Val.
@@ -4879,7 +4109,7 @@ check_integer(S, NNL) ->
check_bitstring(S, NNL0) ->
NNL = check_named_number_list(S, NNL0),
- _ = [asn1_error(S, S#state.type, {invalid_bit_number,Bit}) ||
+ _ = [asn1_error(S, {invalid_bit_number,Bit}) ||
{_,Bit} <- NNL, Bit < 0],
NNL.
@@ -4904,7 +4134,7 @@ check_type_identifier(S, Eref=#'Externaltypereference'{type=Class}) ->
{_,TD=#typedef{typespec=#type{def=#'Externaltypereference'{}}}} ->
check_type_identifier(S, (TD#typedef.typespec)#type.def);
_ ->
- asn1_error(S, S#state.type, {illegal_instance_of,Class})
+ asn1_error(S, {illegal_instance_of,Class})
end.
iof_associated_type(S,[]) ->
@@ -4913,12 +4143,7 @@ iof_associated_type(S,[]) ->
case get(instance_of) of
undefined ->
AssociateSeq = iof_associated_type1(S,[]),
- Tag =
- case S#state.erule of
- ber ->
- [?TAG_CONSTRUCTED(?N_INSTANCE_OF)];
- _ -> []
- end,
+ Tag = [?TAG_CONSTRUCTED(?N_INSTANCE_OF)],
TypeDef=#typedef{checked=true,
name='INSTANCE OF',
typespec=#type{tag=Tag,
@@ -4944,16 +4169,11 @@ iof_associated_type1(S,C) ->
[] -> 'ASN1_OPEN_TYPE';
_ -> {typefield,'Type'}
end,
- {ObjIdTag,C1TypeTag}=
- case S#state.erule of
- ber ->
- {[{'UNIVERSAL',8}],
- [#tag{class='UNIVERSAL',
- number=6,
- type='IMPLICIT',
- form=0}]};
- _ -> {[{'UNIVERSAL','INTEGER'}],[]}
- end,
+ ObjIdTag = [{'UNIVERSAL',8}],
+ C1TypeTag = [#tag{class='UNIVERSAL',
+ number=6,
+ type='IMPLICIT',
+ form=0}],
TypeIdentifierRef=#'Externaltypereference'{module=ModuleName,
type='TYPE-IDENTIFIER'},
ObjectIdentifier =
@@ -4992,9 +4212,13 @@ iof_associated_type1(S,C) ->
%% returns the leading attribute, the constraint of the components and
%% the tablecinf value for the second component.
-instance_of_constraints(_,[]) ->
+instance_of_constraints(_, []) ->
{false,[],[],[]};
-instance_of_constraints(S, [{simpletable,Type}]) ->
+instance_of_constraints(S, [{element_set,{simpletable,C},none}]) ->
+ {element_set,Type,none} = C,
+ instance_of_constraints_1(S, Type).
+
+instance_of_constraints_1(S, Type) ->
#type{def=#'Externaltypereference'{type=Name}} = Type,
ModuleName = S#state.mname,
ObjectSetRef=#'Externaltypereference'{module=ModuleName,
@@ -5014,93 +4238,100 @@ instance_of_constraints(S, [{simpletable,Type}]) ->
valueindex=[]},
{TableCInf,[{simpletable,Name}],CRel,[{objfun,ObjectSetRef}]}.
-%% Check ENUMERATED
-%% ****************************************
-%% Check that all values are unique
-%% assign values to un-numbered identifiers
-%% check that the constraints are allowed and correct
-%% put the updated info back into database
-check_enumerated(_S,[{Name,Number}|_Rest]= NNList,_Constr) when is_atom(Name), is_integer(Number)->
- %% already checked , just return the same list
- NNList;
-check_enumerated(_S,{[{Name,Number}|_Rest],L}= NNList,_Constr) when is_atom(Name), is_integer(Number), is_list(L)->
- %% already checked , contains extension marker, just return the same lists
- NNList;
-check_enumerated(S,NamedNumberList,_Constr) ->
- check_enum(S,NamedNumberList,[],[],[]).
-
-%% identifiers are put in Acc2
-%% returns either [{Name,Number}] or {[{Name,Number}],[{ExtName,ExtNumber}]}
-%% the latter is returned if the ENUMERATION contains EXTENSIONMARK
-check_enum(S,[{'NamedNumber',Id,Num}|T],Acc1,Acc2,Root) when is_integer(Num) ->
- check_enum(S,T,[{Id,Num}|Acc1],Acc2,Root);
-check_enum(S,['EXTENSIONMARK'|T],Acc1,Acc2,_Root) ->
- NewAcc2 = lists:keysort(2,Acc1),
- NewList = enum_number(lists:reverse(Acc2),NewAcc2,0,[],[]),
- { NewList, check_enum(S,T,[],[],enum_counts(NewList))};
-check_enum(S,[Id|T],Acc1,Acc2,Root) when is_atom(Id) ->
- check_enum(S,T,Acc1,[Id|Acc2],Root);
-check_enum(_S,[],Acc1,Acc2,Root) ->
- NewAcc2 = lists:keysort(2,Acc1),
- enum_number(lists:reverse(Acc2),NewAcc2,0,[],Root).
-
-
-% assign numbers to identifiers , numbers from 0 ... but must not
-% be the same as already assigned to NamedNumbers
-enum_number(Identifiers,NamedNumbers,Cnt,Acc,[]) ->
- enum_number(Identifiers,NamedNumbers,Cnt,Acc);
-enum_number(Identifiers,NamedNumbers,_Cnt,Acc,CountL) ->
- enum_extnumber(Identifiers,NamedNumbers,Acc,CountL).
-
-enum_number([H|T],[{Id,Num}|T2],Cnt,Acc) when Num > Cnt ->
- enum_number(T,[{Id,Num}|T2],Cnt+1,[{H,Cnt}|Acc]);
-enum_number([H|T],[{Id,Num}|T2],Cnt,Acc) when Num < Cnt -> % negative Num
- enum_number(T,T2,Cnt+1,[{H,Cnt},{Id,Num}|Acc]);
-enum_number([],L2,_Cnt,Acc) ->
- lists:append([lists:reverse(Acc),L2]);
-enum_number(L,[{Id,Num}|T2],Cnt,Acc) -> % Num == Cnt
- enum_number(L,T2,Cnt+1,[{Id,Num}|Acc]);
-enum_number([H|T],[],Cnt,Acc) ->
- enum_number(T,[],Cnt+1,[{H,Cnt}|Acc]).
-
-enum_extnumber(Identifiers,NamedNumbers,Acc,[C]) ->
- check_add_enum_numbers(NamedNumbers,[C]),
- enum_number(Identifiers,NamedNumbers,C,Acc);
-enum_extnumber([H|T],[{Id,Num}|T2],Acc,[C|Counts]) when Num > C ->
- enum_extnumber(T,[{Id,Num}|T2],[{H,C}|Acc],Counts);
-enum_extnumber([],L2,Acc,Cnt) ->
- check_add_enum_numbers(L2, Cnt),
- lists:concat([lists:reverse(Acc),L2]);
-enum_extnumber(_Identifiers,[{Id,Num}|_T2],_Acc,[C|_]) when Num < C ->
-%% enum_extnumber(Identifiers,T2,[{Id,Num}|Acc],Counts);
- exit({error,{asn1,"AdditionalEnumeration element with same number as root element",{Id,Num}}});
-enum_extnumber(Identifiers,[{Id,Num}|T2],Acc,[_C|Counts]) -> % Num =:= C
- enum_extnumber(Identifiers,T2,[{Id,Num}|Acc],Counts);
-enum_extnumber([H|T],[],Acc,[C|Counts]) ->
- enum_extnumber(T,[],[{H,C}|Acc],Counts).
-
-enum_counts([]) ->
- [0];
-enum_counts(L) ->
- Used=[I||{_,I}<-L],
- AddEnumLb = lists:max(Used) + 1,
- lists:foldl(fun(El,AccIn)->lists:delete(El,AccIn) end,
- lists:seq(0,AddEnumLb),
- Used).
-check_add_enum_numbers(L, Cnt) ->
- Max = lists:max(Cnt),
- Fun = fun({_,N}=El) when N < Max ->
- case lists:member(N,Cnt) of
- false ->
- exit({error,{asn1,"AdditionalEnumeration element with same number as root element",El}});
- _ ->
- ok
- end;
- (_) ->
- ok
- end,
- lists:foreach(Fun,L).
+%%%
+%%% Check ENUMERATED.
+%%%
+check_enumerated(_S, [{Name,Number}|_]=NNL)
+ when is_atom(Name), is_integer(Number) ->
+ %% Already checked.
+ NNL;
+check_enumerated(_S, {[{Name,Number}|_],L}=NNL)
+ when is_atom(Name), is_integer(Number), is_list(L) ->
+ %% Already checked (with extension).
+ NNL;
+check_enumerated(S, NNL) ->
+ check_enum_ids(S, NNL, gb_sets:empty()),
+ check_enum(S, NNL, gb_sets:empty(), []).
+
+check_enum_ids(S, [{'NamedNumber',Id,_}|T], Ids0) ->
+ Ids = check_enum_update_ids(S, Id, Ids0),
+ check_enum_ids(S, T, Ids);
+check_enum_ids(S, ['EXTENSIONMARK'|T], Ids) ->
+ check_enum_ids(S, T, Ids);
+check_enum_ids(S, [Id|T], Ids0) when is_atom(Id) ->
+ Ids = check_enum_update_ids(S, Id, Ids0),
+ check_enum_ids(S, T, Ids);
+check_enum_ids(_, [], _) ->
+ ok.
+
+check_enum(S, [{'NamedNumber',Id,N}|T], Used0, Acc) ->
+ Used = check_enum_update_used(S, Id, N, Used0),
+ check_enum(S, T, Used, [{Id,N}|Acc]);
+check_enum(S, ['EXTENSIONMARK'|Ext0], Used0, Acc0) ->
+ Acc = lists:reverse(Acc0),
+ {Root,Used,Cnt} = check_enum_number_root(Acc, Used0, 0, []),
+ Ext = check_enum_ext(S, Ext0, Used, Cnt, []),
+ {Root,Ext};
+check_enum(S, [Id|T], Used, Acc) when is_atom(Id) ->
+ check_enum(S, T, Used, [Id|Acc]);
+check_enum(_, [], Used, Acc0) ->
+ Acc = lists:reverse(Acc0),
+ {Root,_,_} = check_enum_number_root(Acc, Used, 0, []),
+ lists:keysort(2, Root).
+
+check_enum_number_root([Id|T]=T0, Used0, Cnt, Acc) when is_atom(Id) ->
+ case gb_sets:is_element(Cnt, Used0) of
+ false ->
+ Used = gb_sets:insert(Cnt, Used0),
+ check_enum_number_root(T, Used, Cnt+1, [{Id,Cnt}|Acc]);
+ true ->
+ check_enum_number_root(T0, Used0, Cnt+1, Acc)
+ end;
+check_enum_number_root([H|T], Used, Cnt, Acc) ->
+ check_enum_number_root(T, Used, Cnt, [H|Acc]);
+check_enum_number_root([], Used, Cnt, Acc) ->
+ {lists:keysort(2, Acc),Used,Cnt}.
+
+check_enum_ext(S, [{'NamedNumber',Id,N}|T], Used0, C, Acc) ->
+ Used = check_enum_update_used(S, Id, N, Used0),
+ if
+ N < C ->
+ asn1_error(S, {enum_not_ascending,Id,N,C-1});
+ true ->
+ ok
+ end,
+ check_enum_ext(S, T, Used, N+1, [{Id,N}|Acc]);
+check_enum_ext(S, [Id|T]=T0, Used0, C, Acc) when is_atom(Id) ->
+ case gb_sets:is_element(C, Used0) of
+ true ->
+ check_enum_ext(S, T0, Used0, C+1, Acc);
+ false ->
+ Used = gb_sets:insert(C, Used0),
+ check_enum_ext(S, T, Used, C+1, [{Id,C}|Acc])
+ end;
+check_enum_ext(_, [], _, _, Acc) ->
+ lists:keysort(2, Acc).
+
+check_enum_update_ids(S, Id, Ids) ->
+ case gb_sets:is_element(Id, Ids) of
+ false ->
+ gb_sets:insert(Id, Ids);
+ true ->
+ asn1_error(S, {enum_illegal_redefinition,Id})
+ end.
+
+check_enum_update_used(S, Id, N, Used) ->
+ case gb_sets:is_element(N, Used) of
+ false ->
+ gb_sets:insert(N, Used);
+ true ->
+ asn1_error(S, {enum_reused_value,Id,N})
+ end.
+
+%%%
+%%% End of ENUMERATED checking.
+%%%
check_boolean(_S,_Constr) ->
ok.
@@ -5145,7 +4376,7 @@ check_sequence(S,Type,Comps) ->
CompListTuple = complist_as_tuple(NewComps4),
{CRelInf,CompListTuple};
Dupl ->
- throw({error,{asn1,{duplicate_components,Dupl}}})
+ asn1_error(S, {duplicate_identifier, error_value(hd(Dupl))})
end.
complist_as_tuple(CompList) ->
@@ -5155,8 +4386,6 @@ complist_as_tuple([#'EXTENSIONMARK'{}|T], Acc, Ext, Acc2, root) ->
complist_as_tuple(T, Acc, Ext, Acc2, ext);
complist_as_tuple([#'EXTENSIONMARK'{}|T], Acc, Ext, Acc2, ext) ->
complist_as_tuple(T, Acc, Ext, Acc2, root2);
-complist_as_tuple([#'EXTENSIONMARK'{}|_T], _Acc, _Ext, _Acc2, root2) ->
- throw({error,{asn1,{too_many_extension_marks}}});
complist_as_tuple([C|T], Acc, Ext, Acc2, root) ->
complist_as_tuple(T, [C|Acc], Ext, Acc2, root);
complist_as_tuple([C|T], Acc, Ext, Acc2, ext) ->
@@ -5199,11 +4428,11 @@ expand_components2(S,{_,PT={pt,_,_}}) ->
expand_components2(S,{_,OCFT = #'ObjectClassFieldType'{}}) ->
UncheckedType = #type{def=OCFT},
Type = check_type(S,#typedef{typespec=UncheckedType},UncheckedType),
- expand_components2(S,{undefined,oCFT_def(S,Type)});
+ expand_components2(S, {undefined,ocft_def(Type)});
expand_components2(S,{_,ERef}) when is_record(ERef,'Externaltypereference') ->
expand_components2(S,get_referenced_type(S,ERef));
-expand_components2(_S,Err) ->
- throw({error,{asn1,{illegal_COMPONENTS_OF,Err}}}).
+expand_components2(S,{_, What}) ->
+ asn1_error(S, {illegal_COMPONENTS_OF, error_value(What)}).
take_only_rootset([])->
[];
@@ -5252,7 +4481,7 @@ check_sequenceof(S,Type,Component) when is_record(Component,type) ->
check_set(S,Type,Components) ->
{TableCInf,NewComponents} = check_sequence(S,Type,Components),
- check_distinct_tags(NewComponents,[]),
+ check_unique_tags(S, collect_components(NewComponents), []),
case {lists:member(der,S#state.options),S#state.erule} of
{true,_} ->
{Sorted,SortedComponents} = sort_components(der,S,NewComponents),
@@ -5264,35 +4493,21 @@ check_set(S,Type,Components) ->
{false,TableCInf,NewComponents}
end.
-
-%% check that all tags are distinct according to X.680 26.3
-check_distinct_tags({C1,C2,C3},Acc) when is_list(C1),is_list(C2),is_list(C3) ->
- check_distinct_tags(C1++C2++C3,Acc);
-check_distinct_tags({C1,C2},Acc) when is_list(C1),is_list(C2) ->
- check_distinct_tags(C1++C2,Acc);
-check_distinct_tags([#'ComponentType'{tags=[T]}|Cs],Acc) ->
- check_distinct(T,Acc),
- check_distinct_tags(Cs,[T|Acc]);
-check_distinct_tags([C=#'ComponentType'{tags=[T|Ts]}|Cs],Acc) ->
- check_distinct(T,Acc),
- check_distinct_tags([C#'ComponentType'{tags=Ts}|Cs],[T|Acc]);
-check_distinct_tags([#'ComponentType'{tags=[]}|_Cs],_Acc) ->
- throw({error,"Not distinct tags in SET"});
-check_distinct_tags([],_) ->
- ok.
-check_distinct(T,Acc) ->
- case lists:member(T,Acc) of
- true ->
- throw({error,"Not distinct tags in SET"});
- _ -> ok
- end.
+collect_components({C1,C2,C3}) ->
+ collect_components(C1++C2++C3);
+collect_components({C1,C2}) ->
+ collect_components(C1++C2);
+collect_components(Cs) ->
+ %% Assert that tags are not empty
+ [] = [EmptyTag || EmptyTag = #'ComponentType'{tags=[]} <- Cs],
+ Cs.
%% sorting in canonical order according to X.680 8.6, X.691 9.2
%% DER: all components shall be sorted in canonical order.
%% PER: only root components shall be sorted in canonical order. The
%% extension components shall remain in textual order.
%%
-sort_components(der,S=#state{tname=TypeName},Components) ->
+sort_components(der, S, Components) ->
{R1,Ext,R2} = extension(textual_order(Components)),
CompsList = case Ext of
noext -> R1;
@@ -5300,88 +4515,34 @@ sort_components(der,S=#state{tname=TypeName},Components) ->
end,
case {untagged_choice(S,CompsList),Ext} of
{false,noext} ->
- {true,sort_components1(S,TypeName,CompsList,[],[],[],[])};
+ {true,sort_components1(CompsList)};
{false,_} ->
- {true,{sort_components1(S,TypeName,CompsList,[],[],[],[]), []}};
+ {true,{sort_components1(CompsList),[]}};
{true,noext} ->
%% sort in run-time
{dynamic,R1};
_ ->
{dynamic,{R1, Ext, R2}}
end;
-sort_components(per,S=#state{tname=TypeName},Components) ->
+sort_components(per, S, Components) ->
{R1,Ext,R2} = extension(textual_order(Components)),
Root = tag_untagged_choice(S,R1++R2),
case Ext of
noext ->
- {true,sort_components1(S,TypeName,Root,[],[],[],[])};
+ {true,sort_components1(Root)};
_ ->
- {true,{sort_components1(S,TypeName,Root,[],[],[],[]),
- Ext}}
+ {true,{sort_components1(Root),Ext}}
end.
-sort_components1(S,TypeName,[C=#'ComponentType'{tags=[{'UNIVERSAL',_}|_R]}|Cs],
- UnivAcc,ApplAcc,ContAcc,PrivAcc) ->
- sort_components1(S,TypeName,Cs,[C|UnivAcc],ApplAcc,ContAcc,PrivAcc);
-sort_components1(S,TypeName,[C=#'ComponentType'{tags=[{'APPLICATION',_}|_R]}|Cs],
- UnivAcc,ApplAcc,ContAcc,PrivAcc) ->
- sort_components1(S,TypeName,Cs,UnivAcc,[C|ApplAcc],ContAcc,PrivAcc);
-sort_components1(S,TypeName,[C=#'ComponentType'{tags=[{'CONTEXT',_}|_R]}|Cs],
- UnivAcc,ApplAcc,ContAcc,PrivAcc) ->
- sort_components1(S,TypeName,Cs,UnivAcc,ApplAcc,[C|ContAcc],PrivAcc);
-sort_components1(S,TypeName,[C=#'ComponentType'{tags=[{'PRIVATE',_}|_R]}|Cs],
- UnivAcc,ApplAcc,ContAcc,PrivAcc) ->
- sort_components1(S,TypeName,Cs,UnivAcc,ApplAcc,ContAcc,[C|PrivAcc]);
-sort_components1(S,TypeName,[],UnivAcc,ApplAcc,ContAcc,PrivAcc) ->
- I = #'ComponentType'.tags,
- ascending_order_check(S,TypeName,sort_universal_type(UnivAcc)) ++
- ascending_order_check(S,TypeName,lists:keysort(I,ApplAcc)) ++
- ascending_order_check(S,TypeName,lists:keysort(I,ContAcc)) ++
- ascending_order_check(S,TypeName,lists:keysort(I,PrivAcc)).
-
-ascending_order_check(S,TypeName,Components) ->
- ascending_order_check1(S,TypeName,Components),
- Components.
-
-ascending_order_check1(S,TypeName,
- [C1 = #'ComponentType'{tags=[{_,T}|_]},
- C2 = #'ComponentType'{tags=[{_,T}|_]}|Rest]) ->
- asn1ct:warning("Indistinct tag ~p in SET ~p, components ~p and ~p~n",
- [T,TypeName,C1#'ComponentType'.name,C2#'ComponentType'.name],S,
- "Indistinct tag in SET"),
- ascending_order_check1(S,TypeName,[C2|Rest]);
-ascending_order_check1(S,TypeName,
- [C1 = #'ComponentType'{tags=[{'UNIVERSAL',T1}|_]},
- C2 = #'ComponentType'{tags=[{'UNIVERSAL',T2}|_]}|Rest]) ->
- case (decode_type(T1) == decode_type(T2)) of
- true ->
- asn1ct:warning("Indistinct tags ~p and ~p in"
- " SET ~p, components ~p and ~p~n",
- [T1,T2,TypeName,C1#'ComponentType'.name,
- C2#'ComponentType'.name],S,
- "Indistinct tags and in SET"),
- ascending_order_check1(S,TypeName,[C2|Rest]);
- _ ->
- ascending_order_check1(S,TypeName,[C2|Rest])
- end;
-ascending_order_check1(S,N,[_|Rest]) ->
- ascending_order_check1(S,N,Rest);
-ascending_order_check1(_,_,[]) ->
- ok.
-
-sort_universal_type(Components) ->
- List = lists:map(fun(C) ->
- #'ComponentType'{tags=[{_,T}|_]} = C,
- {decode_type(T),C}
- end,
- Components),
- SortedList = lists:keysort(1,List),
- lists:map(fun(X)->element(2,X) end,SortedList).
-
-decode_type(I) when is_integer(I) ->
- I;
-decode_type(T) ->
- asn1ct_gen_ber_bin_v2:decode_type(T).
+sort_components1(Cs0) ->
+ Cs1 = [{tag_key(Tag),C} || #'ComponentType'{tags=[Tag|_]}=C <- Cs0],
+ Cs = lists:sort(Cs1),
+ [C || {_,C} <- Cs].
+
+tag_key({'UNIVERSAL',Tag}) -> {0,Tag};
+tag_key({'APPLICATION',Tag}) -> {1,Tag};
+tag_key({'CONTEXT',Tag}) -> {2,Tag};
+tag_key({'PRIVATE',Tag}) -> {3,Tag}.
untagged_choice(_S,[#'ComponentType'{typespec=#type{tag=[],def={'CHOICE',_}}}|_Rest]) ->
true;
@@ -5477,35 +4638,43 @@ check_selectiontype(S,Name,#type{def=Eref})
{RefMod,TypeDef} = get_referenced_type(S,Eref),
NewS = S#state{module=load_asn1_module(S,RefMod),
mname=RefMod,
- type=TypeDef,
tname=get_datastr_name(TypeDef)},
check_selectiontype2(NewS,Name,TypeDef);
check_selectiontype(S,Name,Type=#type{def={pt,_,_}}) ->
- TName =
- case S#state.recordtopname of
- [] ->
- S#state.tname;
- N -> N
- end,
+ TName = case S#state.recordtopname of
+ [] -> S#state.tname;
+ N -> N
+ end,
TDef = #typedef{name=TName,typespec=Type},
check_selectiontype2(S,Name,TDef);
-check_selectiontype(S,Name,Type) ->
- Msg = lists:flatten(io_lib:format("SelectionType error: ~w < ~w must be a reference to a CHOICE.",[Name,Type])),
- error({type,Msg,S}).
+check_selectiontype(S, _Name, Type) ->
+ asn1_error(S, {illegal_choice_type, error_value(Type)}).
check_selectiontype2(S,Name,TypeDef) ->
NewS = S#state{recordtopname=get_datastr_name(TypeDef)},
- CheckedType = check_type(NewS,TypeDef,TypeDef#typedef.typespec),
- Components = get_choice_components(S,CheckedType#type.def),
- case lists:keysearch(Name,#'ComponentType'.name,Components) of
- {value,C} ->
- %% The selected type will have the tag of the selected type.
- _T = C#'ComponentType'.typespec;
-% T#type{tag=def_to_tag(NewS,T#type.def)};
- _ ->
- Msg = lists:flatten(io_lib:format("error checking SelectionType: ~w~n",[Name])),
- error({type,Msg,S})
+ Components =
+ try
+ CheckedType = check_type(NewS,TypeDef,TypeDef#typedef.typespec),
+ get_choice_components(S,CheckedType#type.def)
+ catch error:_ ->
+ asn1_error(S, {illegal_choice_type, error_value(TypeDef)})
+ end,
+ case lists:keyfind(Name, #'ComponentType'.name, Components) of
+ #'ComponentType'{typespec=TS} -> TS;
+ false -> asn1_error(S, {illegal_id, error_value(Name)})
end.
+
+
+get_choice_components(_S,{'CHOICE',Components}) when is_list(Components)->
+ Components;
+get_choice_components(_S,{'CHOICE',{C1,C2}}) when is_list(C1),is_list(C2) ->
+ C1++C2;
+get_choice_components(S,ERef=#'Externaltypereference'{}) ->
+ {_RefMod,TypeDef}=get_referenced_type(S,ERef),
+ #typedef{typespec=TS} = TypeDef,
+ get_choice_components(S,TS#type.def).
+
+
check_restrictedstring(_S,_Def,_Constr) ->
ok.
@@ -5538,7 +4707,7 @@ check_choice(S,Type,Components) when is_list(Components) ->
check_unique_tags(S, NewComps3),
complist_as_tuple(NewComps3);
Dupl ->
- throw({error,{asn1,{duplicate_choice_alternatives,Dupl}}})
+ asn1_error(S, {duplicate_identifier,error_value(hd(Dupl))})
end;
check_choice(_S,_,[]) ->
[].
@@ -5635,25 +4804,30 @@ check_unique_tags(S,C) ->
case (S#state.module)#module.tagdefault of
'AUTOMATIC' ->
case any_manual_tag(C) of
- false -> true;
- _ -> collect_and_sort_tags(C,[])
+ false ->
+ true;
+ true ->
+ check_unique_tags(S, C, [])
end;
_ ->
- collect_and_sort_tags(C,[])
+ check_unique_tags(S, C, [])
end.
-collect_and_sort_tags([C|Rest],Acc) when is_record(C,'ComponentType') ->
- collect_and_sort_tags(Rest,C#'ComponentType'.tags ++ Acc);
-collect_and_sort_tags([_|Rest],Acc) ->
- collect_and_sort_tags(Rest,Acc);
-collect_and_sort_tags([],Acc) ->
- {Dupl,_}= lists:mapfoldl(fun(El,El)->{{dup,El},El};(El,_Prev)-> {El,El} end,notag,lists:sort(Acc)),
- Dupl2 = [Dup|| {dup,Dup} <- Dupl],
- if
- length(Dupl2) > 0 ->
- throw({error,{asn1,{duplicates_of_the_tags,Dupl2}}});
- true ->
- true
+check_unique_tags(S, [#'ComponentType'{name=Name,tags=Tags0}|T], Acc) ->
+ Tags = [{Tag,Name} || Tag <- Tags0],
+ check_unique_tags(S, T, Tags ++ Acc);
+check_unique_tags(S, [_|T], Acc) ->
+ check_unique_tags(S, T, Acc);
+check_unique_tags(S, [], Acc) ->
+ R0 = sofs:relation(Acc),
+ R1 = sofs:relation_to_family(R0),
+ R2 = sofs:to_external(R1),
+ Dup = [Els || {_,[_,_|_]=Els} <- R2],
+ case Dup of
+ [] ->
+ ok;
+ [FirstDupl|_] ->
+ asn1_error(S, {duplicate_tags,FirstDupl})
end.
check_unique(L,Pos) ->
@@ -5795,28 +4969,18 @@ componentrelation_leadingattr(S,[C= #'ComponentType'{}|Cs],CompList,Acc,CompAcc)
{[],C};
[{ObjSet,Attr,N,ClassDef,_Path,ValueIndex}|_NewRest] ->
OS = object_set_mod_name(S,ObjSet),
- UniqueFieldName =
- case (catch get_unique_fieldname(S,#classdef{typespec=ClassDef})) of
- {error,'__undefined_',_} ->
- no_unique;
- {asn1,Msg,_} ->
- error({type,Msg,S});
- {'EXIT',Msg} ->
- error({type,{internal_error,Msg},S});
- {Other,_} -> Other
- end,
-% UsedFieldName = get_used_fieldname(S,Attr,STList),
+ UniqFN = get_unique_fieldname(S,
+ #classdef{typespec=ClassDef}),
%% Res should be done differently: even though
%% a unique field name exists it is not
%% certain that the ObjectClassFieldType of
%% the simple table constraint picks that
%% class field.
Res = #simpletableattributes{objectsetname=OS,
-%% c_name=asn1ct_gen:un_hyphen_var(Attr),
c_name=Attr,
c_index=N,
- usedclassfield=UniqueFieldName,
- uniqueclassfield=UniqueFieldName,
+ usedclassfield=UniqFN,
+ uniqueclassfield=UniqFN,
valueindex=ValueIndex},
{[Res],C#'ComponentType'{typespec=NewTSpec}}
end;
@@ -5869,7 +5033,7 @@ remove_doubles1(El,L) ->
NewL -> remove_doubles1(El,NewL)
end.
-%% get_simple_table_info searches the commponents Cs by the path from
+%% get_simple_table_info searches the components Cs by the path from
%% an at-list (third argument), and follows into a component of it if
%% necessary, to get information needed for code generating.
%%
@@ -5884,32 +5048,35 @@ remove_doubles1(El,L) ->
% %% at least one step below the outermost level, i.e. the leading
% %% information shall be on a sub level. 2) They don't have any common
% %% path.
-get_simple_table_info(S,Cs,[AtList|Rest]) ->
- [get_simple_table_info1(S,Cs,AtList,[])|get_simple_table_info(S,Cs,Rest)];
-get_simple_table_info(_,_,[]) ->
- [].
-get_simple_table_info1(S,Cs,[Cname|Cnames],Path) when is_list(Cs) ->
- case lists:keysearch(Cname,#'ComponentType'.name,Cs) of
- {value,C} ->
- get_simple_table_info1(S,C,Cnames,[Cname|Path]);
- _ ->
- error({type,"Missing expected simple table constraint",S})
- end;
-get_simple_table_info1(S,#'ComponentType'{typespec=TS},[],Path) ->
- %% In this component there must be a simple table constraint
- %% o.w. the asn1 code is wrong.
- #type{def=OCFT,constraint=Cnstr} = TS,
- case constraint_member(simpletable,Cnstr) of
- {true,{simpletable,_OSRef}} ->
- simple_table_info(S,OCFT,Path);
- _ ->
- error({type,{"missing expected simple table constraint",
- Cnstr},S})
+get_simple_table_info(S, Cs, AtLists) ->
+ [get_simple_table_info1(S, Cs, AtList, []) || AtList <- AtLists].
+
+get_simple_table_info1(S, Cs, [Cname|Cnames], Path) ->
+ #'ComponentType'{} = C =
+ lists:keyfind(Cname, #'ComponentType'.name, Cs),
+ get_simple_table_info2(S, C, Cnames, [Cname|Path]).
+
+get_simple_table_info2(S, #'ComponentType'{name=Name,typespec=TS}, [], Path) ->
+ OCFT = simple_table_get_ocft(S, Name, TS),
+ case lists:keymember(simpletable, 1, TS#type.constraint) of
+ true ->
+ simple_table_info(S, OCFT, Path);
+ false ->
+ asn1_error(S, {missing_table_constraint,Name})
end;
-get_simple_table_info1(S,#'ComponentType'{typespec=TS},Cnames,Path) ->
+get_simple_table_info2(S, #'ComponentType'{typespec=TS}, Cnames, Path) ->
Components = get_atlist_components(TS#type.def),
- get_simple_table_info1(S,Components,Cnames,Path).
-
+ get_simple_table_info1(S, Components, Cnames, Path).
+
+simple_table_get_ocft(_, _, #type{def=#'ObjectClassFieldType'{}=OCFT}) ->
+ OCFT;
+simple_table_get_ocft(S, Component, #type{constraint=Constr}) ->
+ case lists:keyfind(ocft, 1, Constr) of
+ {ocft,OCFT} ->
+ OCFT;
+ false ->
+ asn1_error(S, {missing_ocft,Component})
+ end.
simple_table_info(S,#'ObjectClassFieldType'{classname=ClRef,
class=ObjectClass,
@@ -5932,19 +5099,8 @@ simple_table_info(S,#'ObjectClassFieldType'{classname=ClRef,
CDef;
_ -> #classdef{typespec=ObjectClass}
end,
- UniqueName =
- case (catch get_unique_fieldname(S,ClassDef)) of
- {error,'__undefined_',_} -> no_unique;
- {asn1,Msg,_} ->
- error({type,Msg,S});
- {'EXIT',Msg} ->
- error({type,{internal_error,Msg},S});
- {Other,_} -> Other
- end,
- {lists:reverse(Path),ObjectClassFieldName,UniqueName};
-simple_table_info(S,Type,_) ->
- error({type,{"the type referenced by a componentrelation constraint must be a ObjectClassFieldType",Type},S}).
-
+ UniqueName = get_unique_fieldname(S, ClassDef),
+ {lists:reverse(Path),ObjectClassFieldName,UniqueName}.
%% any_component_relation searches for all component relation
%% constraints that refers to the actual level and returns a list of
@@ -5958,9 +5114,8 @@ simple_table_info(S,Type,_) ->
%% is found to check the validity of the at-list.
any_component_relation(S,[#'ComponentType'{name=CName,typespec=Type}|Cs],CNames,NamePath,Acc) ->
CRelPath =
- case constraint_member(componentrelation,Type#type.constraint) of
-%% [{componentrelation,_,AtNotation}] ->
- {true,{_,_,AtNotation}} ->
+ case lists:keyfind(componentrelation, 1, Type#type.constraint) of
+ {_,_,AtNotation} ->
%% Found component relation constraint, now check
%% whether this constraint is relevant for the level
%% where the search started
@@ -5969,7 +5124,7 @@ any_component_relation(S,[#'ComponentType'{name=CName,typespec=Type}|Cs],CNames,
%% simple table constraint from where the component
%% relation is found.
evaluate_atpath(S,NamePath,CNames,AtNot);
- _ ->
+ false ->
[]
end,
InnerAcc =
@@ -5991,11 +5146,11 @@ any_component_relation(S,[#'ComponentType'{name=CName,typespec=Type}|Cs],CNames,
any_component_relation(S,Cs,CNames,NamePath,InnerAcc++CRelPath++Acc);
any_component_relation(S,Type,CNames,NamePath,Acc) when is_record(Type,type) ->
CRelPath =
- case constraint_member(componentrelation,Type#type.constraint) of
- {true,{_,_,AtNotation}} ->
+ case lists:keyfind(componentrelation, 1, Type#type.constraint) of
+ {_,_,AtNotation} ->
AtNot = extract_at_notation(AtNotation),
evaluate_atpath(S,NamePath,CNames,AtNot);
- _ ->
+ false ->
[]
end,
InnerAcc =
@@ -6017,15 +5172,6 @@ any_component_relation(S,['ExtensionAdditionGroupEnd'|Cs],CNames,NamePath,Acc) -
any_component_relation(_,[],_,_,Acc) ->
Acc.
-constraint_member(componentrelation,[CRel={componentrelation,_,_}|_Rest]) ->
- {true,CRel};
-constraint_member(simpletable,[ST={simpletable,_}|_Rest]) ->
- {true,ST};
-constraint_member(Key,[_H|T]) ->
- constraint_member(Key,T);
-constraint_member(_,[]) ->
- false.
-
%% evaluate_atpath/4 finds out whether the at notation refers to the
%% search level. The list of referenced names in the AtNot list shall
%% begin with a name that exists on the level it refers to. If the
@@ -6059,9 +5205,7 @@ evaluate_atpath(S=#state{abscomppath=TopPath},NamePath,Cnames,{outermost,AtPath=
{_,[H|_T]} ->
case lists:member(H,Cnames) of
true -> [AtPathBelowTop];
- _ ->
- %% error({type,{asn1,"failed to analyze at-path",AtPath},S})
- throw({type,{asn1,"failed to analyze at-path",AtPath},S})
+ _ -> asn1_error(S, {invalid_at_path, AtPath})
end
end;
evaluate_atpath(_,_,_,_) ->
@@ -6098,23 +5242,8 @@ tuple2complist({R1,E,R2}) ->
tuple2complist(List) when is_list(List) ->
List.
-get_choice_components(_S,{'CHOICE',Components}) when is_list(Components)->
- Components;
-get_choice_components(_S,{'CHOICE',{C1,C2}}) when is_list(C1),is_list(C2) ->
- C1++C2;
-get_choice_components(S,ERef=#'Externaltypereference'{}) ->
- {_RefMod,TypeDef}=get_referenced_type(S,ERef),
- #typedef{typespec=TS} = TypeDef,
- get_choice_components(S,TS#type.def).
-
-extract_at_notation([{Level,[#'Externalvaluereference'{value=Name}|Rest]}]) ->
- {Level,[Name|extract_at_notation1(Rest)]};
-extract_at_notation(At) ->
- exit({error,{asn1,{at_notation,At}}}).
-extract_at_notation1([#'Externalvaluereference'{value=Name}|Rest]) ->
- [Name|extract_at_notation1(Rest)];
-extract_at_notation1([]) ->
- [].
+extract_at_notation([{Level,ValueRefs}]) ->
+ {Level,[Name || #'Externalvaluereference'{value=Name} <- ValueRefs]}.
%% componentrelation1/1 identifies all componentrelation constraints
%% that exist in C or in the substructure of C. Info about the found
@@ -6133,8 +5262,8 @@ componentrelation1(S,C = #type{def=Def,constraint=Constraint,tablecinf=TCI},
Ret =
% case Constraint of
% [{componentrelation,{_,_,ObjectSet},AtList}|_Rest] ->
- case constraint_member(componentrelation,Constraint) of
- {true,{_,{_,_,ObjectSet},AtList}} ->
+ case lists:keyfind(componentrelation, 1, Constraint) of
+ {_,{_,_,ObjectSet},AtList} ->
[{_,AL=[#'Externalvaluereference'{}|_R1]}|_R2] = AtList,
%% Note: if Path is longer than one,i.e. it is within
%% an inner type of the actual level, then the only
@@ -6145,7 +5274,7 @@ componentrelation1(S,C = #type{def=Def,constraint=Constraint,tablecinf=TCI},
lists:map(fun(#'Externalvaluereference'{value=V})->V end,
AL),
{[{ObjectSet,AtPath,ClassDef,Path}],Def};
- _ ->
+ false ->
%% check the inner type of component
innertype_comprel(S,Def,Path)
end,
@@ -6219,10 +5348,8 @@ componentlist_comprel(_,[],Acc,_,NewCL) ->
innertype_comprel1(S,T = #type{def=Def,constraint=Cons,tablecinf=TCI},Path) ->
Ret =
-% case Cons of
-% [{componentrelation,{_,_,ObjectSet},AtList}|_Rest] ->
- case constraint_member(componentrelation,Cons) of
- {true,{_,{_,_,ObjectSet},AtList}} ->
+ case lists:keyfind(componentrelation, 1, Cons) of
+ {_,{_,_,ObjectSet},AtList} ->
%% This AtList must have an "outermost" at sign to be
%% relevent here.
[{_,AL=[#'Externalvaluereference'{value=_Attr}|_R1]}|_R2]
@@ -6233,7 +5360,7 @@ innertype_comprel1(S,T = #type{def=Def,constraint=Cons,tablecinf=TCI},Path) ->
lists:map(fun(#'Externalvaluereference'{value=V})->V end,
AL),
[{ObjectSet,AtPath,ClassDef,Path}];
- _ ->
+ false ->
innertype_comprel(S,Def,Path)
end,
case Ret of
@@ -6301,8 +5428,7 @@ value_match(S,#'ComponentType'{typespec=Type},Name,[At|Ats],Acc) ->
InnerType = asn1ct_gen:get_inner(Type#type.def),
Components =
case get_atlist_components(Type#type.def) of
- [] -> error({type,{asn1,"element in at list must be a "
- "SEQUENCE, SET or CHOICE.",Name},S});
+ [] -> asn1_error(S, {invalid_element, Name});
Comps -> Comps
end,
{Index,ValueIndex} = component_value_index(S,InnerType,At,Components),
@@ -6322,29 +5448,27 @@ component_index1(_S,Name,[#'ComponentType'{name=Name}|_Cs],N) ->
component_index1(S,Name,[_C|Cs],N) ->
component_index1(S,Name,Cs,N+1);
component_index1(S,Name,[],_) ->
- error({type,{asn1,"component of at-list was not"
- " found in substructure",Name},S}).
+ asn1_error(S, {invalid_at_list, Name}).
-get_unique_fieldname(_S,ClassDef) when is_record(ClassDef,classdef) ->
-%% {_,Fields,_} = ClassDef#classdef.typespec,
- Fields = (ClassDef#classdef.typespec)#objectclass.fields,
- get_unique_fieldname1(Fields,[]);
+get_unique_fieldname(S, #classdef{typespec=TS}) ->
+ Fields = TS#objectclass.fields,
+ get_unique_fieldname1(S, Fields, []);
get_unique_fieldname(S,#typedef{typespec=#type{def=ClassRef}}) ->
%% A class definition may be referenced as
%% REFED-CLASS ::= DEFINED-CLASS and then REFED-CLASS is a typedef
{_M,ClassDef} = get_referenced_type(S,ClassRef),
get_unique_fieldname(S,ClassDef).
-get_unique_fieldname1([],[]) ->
- throw({error,'__undefined_',[]});
-get_unique_fieldname1([],[Name]) ->
- Name;
-get_unique_fieldname1([],Acc) ->
- throw({asn1,'only one UNIQUE field is allowed in CLASS',Acc});
-get_unique_fieldname1([{fixedtypevaluefield,Name,_,'UNIQUE',Opt}|Rest],Acc) ->
- get_unique_fieldname1(Rest,[{Name,Opt}|Acc]);
-get_unique_fieldname1([_H|T],Acc) ->
- get_unique_fieldname1(T,Acc).
+get_unique_fieldname1(S, [{fixedtypevaluefield,Name,_,'UNIQUE',Opt}|T], Acc) ->
+ get_unique_fieldname1(S, T, [{Name,Opt}|Acc]);
+get_unique_fieldname1(S, [_|T], Acc) ->
+ get_unique_fieldname1(S, T, Acc);
+get_unique_fieldname1(S, [], Acc) ->
+ case Acc of
+ [] -> no_unique;
+ [Name] -> Name;
+ [_|_] -> asn1_error(S, multiple_uniqs)
+ end.
get_tableconstraint_info(S,Type,{CheckedTs,EComps,CheckedTs2}) ->
{get_tableconstraint_info(S,Type,CheckedTs,[]),
@@ -6400,31 +5524,8 @@ get_tableconstraint_info(S,Type,[C|Cs],Acc) ->
get_referenced_fieldname([{_,FirstFieldname}]) ->
{FirstFieldname,[]};
-get_referenced_fieldname([{_,FirstFieldname}|Rest]) ->
- {FirstFieldname,lists:map(fun(X)->element(2,X) end,Rest)};
-get_referenced_fieldname(Def={FieldName,RestFieldName}) when is_atom(FieldName),is_list(RestFieldName)->
- Def;
-get_referenced_fieldname(Def) ->
- {no_type,Def}.
-
-%% get_ObjectClassFieldType extracts the type from the chain of
-%% objects that leads to a final type.
-get_ObjectClassFieldType(S,ERef,PrimFieldNameList) when
- is_record(ERef,'Externaltypereference') ->
- {MName,Type} = get_referenced_type(S,ERef),
- NewS = update_state(S#state{type=Type,
- tname=ERef#'Externaltypereference'.type},MName),
- ClassSpec = check_class(NewS,Type),
- Fields = ClassSpec#objectclass.fields,
- get_ObjectClassFieldType(S,Fields,PrimFieldNameList);
-get_ObjectClassFieldType(S,Fields,L=[_PrimFieldName1|_Rest]) ->
- check_PrimitiveFieldNames(S,Fields,L),
- get_OCFType(S,Fields,L);
-get_ObjectClassFieldType(S,ERef,{FieldName,Rest}) ->
- get_ObjectClassFieldType(S,ERef,Rest ++ [FieldName]).
-
-check_PrimitiveFieldNames(_S,_Fields,_) ->
- ok.
+get_referenced_fieldname([{_,FirstFieldname}|T]) ->
+ {FirstFieldname,[element(2, X) || X <- T]}.
%% get_ObjectClassFieldType_classdef gets the def of the class of the
%% ObjectClassFieldType, i.e. the objectclass record. If the type has
@@ -6445,15 +5546,13 @@ get_OCFType(S,Fields,[PrimFieldName|Rest]) ->
{fixedtypevaluefield,PrimFieldName,Type};
{value,{objectfield,_,ClassRef,_Unique,_OptSpec}} ->
{MName,ClassDef} = get_referenced_type(S,ClassRef),
- NewS = update_state(S#state{type=ClassDef,
- tname=get_datastr_name(ClassDef)},
+ NewS = update_state(S#state{tname=get_datastr_name(ClassDef)},
MName),
CheckedCDef = check_class(NewS,ClassDef),
get_OCFType(S,CheckedCDef#objectclass.fields,Rest);
{value,{objectsetfield,_,Type,_OptSpec}} ->
{MName,ClassDef} = get_referenced_type(S,Type#type.def),
- NewS = update_state(S#state{type=ClassDef,
- tname=get_datastr_name(ClassDef)},
+ NewS = update_state(S#state{tname=get_datastr_name(ClassDef)},
MName),
CheckedCDef = check_class(NewS,ClassDef),
get_OCFType(S,CheckedCDef#objectclass.fields,Rest);
@@ -6461,7 +5560,7 @@ get_OCFType(S,Fields,[PrimFieldName|Rest]) ->
{value,Other} ->
{element(1,Other),PrimFieldName};
_ ->
- throw({error,lists:flatten(io_lib:format("undefined FieldName in ObjectClassFieldType: ~w",[PrimFieldName]))})
+ asn1_error(S, {illegal_object_field, PrimFieldName})
end.
get_taglist(S,Ext) when is_record(Ext,'Externaltypereference') ->
@@ -6485,30 +5584,8 @@ get_taglist(_S,#'ObjectClassFieldType'{type={typefield,_}}) ->
[];
get_taglist(S,#'ObjectClassFieldType'{type={fixedtypevaluefield,_,Type}}) ->
get_taglist(S,Type);
-get_taglist(S,{ERef=#'Externaltypereference'{},FieldNameList})
- when is_list(FieldNameList) ->
- case get_ObjectClassFieldType(S,ERef,FieldNameList) of
- {fixedtypevaluefield,_,Type} -> get_taglist(S,Type);
- {TypeFieldName,_} when is_atom(TypeFieldName) -> []%should check if allowed
- end;
-get_taglist(S,{ObjCl,FieldNameList}) when is_record(ObjCl,objectclass),
- is_list(FieldNameList) ->
- case get_ObjectClassFieldType(S,ObjCl#objectclass.fields,FieldNameList) of
- {fixedtypevaluefield,_,Type} -> get_taglist(S,Type);
- {TypeFieldName,_} when is_atom(TypeFieldName) -> []%should check if allowed
- end;
-get_taglist(S,Def) ->
- case S#state.erule of
- ber ->
- [];
- _ ->
- case Def of
- 'ASN1_OPEN_TYPE' -> % open_type has no UNIVERSAL tag as such
- [];
- _ ->
- [asn1ct_gen:def_to_tag(Def)]
- end
- end.
+get_taglist(_, _) ->
+ [].
get_taglist1(S,[#'ComponentType'{name=_Cname,tags=TagL}|Rest]) when is_list(TagL) ->
%% tag_list has been here , just return TagL and continue with next alternative
@@ -6565,15 +5642,6 @@ get_taglist1(_S,[]) ->
%% tag_number('CHARACTER STRING') -> 29;
%% tag_number('BMPString') -> 30.
-
-dbget_ex(_S,Module,Key) ->
- case asn1_db:dbget(Module,Key) of
- undefined ->
-
- throw({error,{asn1,{undefined,{Module,Key}}}}); % this is catched on toplevel type or value
- T -> T
- end.
-
merge_tags(T1, T2) when is_list(T2) ->
merge_tags2(T1 ++ T2, []);
merge_tags(T1, T2) ->
@@ -6590,75 +5658,46 @@ merge_tags2([H|T],Acc) ->
merge_tags2([], Acc) ->
lists:reverse(Acc).
-%% merge_constraints(C1, []) ->
-%% C1;
-%% merge_constraints([], C2) ->
-%% C2;
-%% merge_constraints(C1, C2) ->
-%% {SList,VList,PAList,Rest} = splitlist(C1++C2,[],[],[],[]),
-%% SizeC = merge_constraints(SList),
-%% ValueC = merge_constraints(VList),
-%% PermAlphaC = merge_constraints(PAList),
-%% case Rest of
-%% [] ->
-%% SizeC ++ ValueC ++ PermAlphaC;
-%% _ ->
-%% throw({error,{asn1,{not_implemented,{merge_constraints,Rest}}}})
-%% end.
-
-%% merge_constraints([]) -> [];
-%% merge_constraints([C1 = {_,{Low1,High1}},{_,{Low2,High2}}|Rest]) when Low1 >= Low2,
-%% High1 =< High2 ->
-%% merge_constraints([C1|Rest]);
-%% merge_constraints([C1={'PermittedAlphabet',_},C2|Rest]) ->
-%% [C1|merge_constraints([C2|Rest])];
-%% merge_constraints([C1 = {_,{_Low1,_High1}},C2 = {_,{_Low2,_High2}}|_Rest]) ->
-%% throw({error,asn1,{conflicting_constraints,{C1,C2}}});
-%% merge_constraints([C]) ->
-%% [C].
-
-%% splitlist([C={'SizeConstraint',_}|Rest],Sacc,Vacc,PAacc,Restacc) ->
-%% splitlist(Rest,[C|Sacc],Vacc,PAacc,Restacc);
-%% splitlist([C={'ValueRange',_}|Rest],Sacc,Vacc,PAacc,Restacc) ->
-%% splitlist(Rest,Sacc,[C|Vacc],PAacc,Restacc);
-%% splitlist([C={'PermittedAlphabet',_}|Rest],Sacc,Vacc,PAacc,Restacc) ->
-%% splitlist(Rest,Sacc,Vacc,[C|PAacc],Restacc);
-%% splitlist([C|Rest],Sacc,Vacc,PAacc,Restacc) ->
-%% splitlist(Rest,Sacc,Vacc,PAacc,[C|Restacc]);
-%% splitlist([],Sacc,Vacc,PAacc,Restacc) ->
-%% {lists:reverse(Sacc),
-%% lists:reverse(Vacc),
-%% lists:reverse(PAacc),
-%% lists:reverse(Restacc)}.
-
-
-
-storeindb(S,M) when is_record(M,module) ->
- TVlist = M#module.typeorval,
- NewM = M#module{typeorval=findtypes_and_values(TVlist)},
- asn1_db:dbnew(NewM#module.name, S#state.erule),
- asn1_db:dbput(NewM#module.name,'MODULE', NewM),
- Res = storeindb(#state{mname=NewM#module.name}, TVlist, []),
- include_default_class(S,NewM#module.name),
+storeindb(S0, #module{name=ModName,typeorval=TVlist0}=M) ->
+ S = S0#state{mname=ModName},
+ TVlist1 = [{asn1ct:get_name_of_def(Def),Def} || Def <- TVlist0],
+ case check_duplicate_defs(S, TVlist1) of
+ ok ->
+ storeindb_1(S, M, TVlist0, TVlist1);
+ {error,_}=Error ->
+ Error
+ end.
+
+storeindb_1(S, #module{name=ModName}=M, TVlist0, TVlist) ->
+ NewM = M#module{typeorval=findtypes_and_values(TVlist0)},
+ asn1_db:dbnew(ModName, S#state.erule),
+ asn1_db:dbput(ModName, 'MODULE', NewM),
+ asn1_db:dbput(ModName, TVlist),
+ include_default_class(S, NewM#module.name),
include_default_type(NewM#module.name),
- Res.
+ ok.
-storeindb(#state{mname=Module}=S, [H|T], Errors) ->
- Name = asn1ct:get_name_of_def(H),
- case asn1_db:dbget(Module, Name) of
- undefined ->
- asn1_db:dbput(Module, Name, H),
- storeindb(S, T, Errors);
- Prev ->
- PrevLine = asn1ct:get_pos_of_def(Prev),
- Error = return_asn1_error(S, H, {already_defined,Name,PrevLine}),
- storeindb(S, T, [Error|Errors])
- end;
-storeindb(_, [], []) ->
- ok;
-storeindb(_, [], [_|_]=Errors) ->
- {error,Errors}.
+check_duplicate_defs(S, Defs) ->
+ Set0 = sofs:relation(Defs),
+ Set1 = sofs:relation_to_family(Set0),
+ Set = sofs:to_external(Set1),
+ case [duplicate_def(S, N, Dup) || {N,[_,_|_]=Dup} <- Set] of
+ [] ->
+ ok;
+ [_|_]=E ->
+ {error,lists:append(E)}
+ end.
+
+duplicate_def(S, Name, Dups0) ->
+ Dups1 = [{asn1ct:get_pos_of_def(Def),Def} || Def <- Dups0],
+ [{Prev,_}|Dups] = lists:sort(Dups1),
+ duplicate_def_1(S, Dups, Name, Prev).
+duplicate_def_1(S, [{_,Def}|T], Name, Prev) ->
+ E = return_asn1_error(S, Def, {already_defined,Name,Prev}),
+ [E|duplicate_def_1(S, T, Name, Prev)];
+duplicate_def_1(_, [], _, _) ->
+ [].
findtypes_and_values(TVList) ->
findtypes_and_values(TVList,[],[],[],[],[],[]).%% Types,Values,
@@ -6698,99 +5737,146 @@ findtypes_and_values([],Tacc,Vacc,Pacc,Cacc,Oacc,OSacc) ->
{lists:reverse(Tacc),lists:reverse(Vacc),lists:reverse(Pacc),
lists:reverse(Cacc),lists:reverse(Oacc),lists:reverse(OSacc)}.
+return_asn1_error(#state{error_context=Context}=S, Error) ->
+ return_asn1_error(S, Context, Error).
+
return_asn1_error(#state{mname=Where}, Item, Error) ->
Pos = asn1ct:get_pos_of_def(Item),
{structured_error,{Where,Pos},?MODULE,Error}.
-asn1_error(S, Item, Error) ->
- throw({error,return_asn1_error(S, Item, Error)}).
+asn1_error(S, Error) ->
+ throw({error,return_asn1_error(S, Error)}).
format_error({already_defined,Name,PrevLine}) ->
io_lib:format("the name ~p has already been defined at line ~p",
[Name,PrevLine]);
+format_error({duplicate_identifier,Ids}) ->
+ io_lib:format("the identifier '~p' has already been used", [Ids]);
+format_error({duplicate_tags,Elements}) ->
+ io_lib:format("duplicate tags in the elements: ~s",
+ [format_elements(Elements)]);
+format_error({enum_illegal_redefinition,Id}) ->
+ io_lib:format("'~s' must not be redefined", [Id]);
+format_error({enum_not_ascending,Id,N,Prev}) ->
+ io_lib:format("the values for enumerations which follow '...' must "
+ "be in ascending order, but '~p(~p)' is less than the "
+ "previous value '~p'", [Id,N,Prev]);
+format_error({enum_reused_value,Id,Val}) ->
+ io_lib:format("'~s' has the value '~p' which is used more than once",
+ [Id,Val]);
+format_error({illegal_id, Id}) ->
+ io_lib:format("illegal identifier: ~p", [Id]);
+format_error({illegal_choice_type, Ref}) ->
+ io_lib:format("expecting a CHOICE type: ~p", [Ref]);
+format_error({illegal_class_name,Class}) ->
+ io_lib:format("the class name '~s' is illegal (it must start with an uppercase letter and only contain uppercase letters, digits, or hyphens)", [Class]);
+format_error({illegal_COMPONENTS_OF, Ref}) ->
+ io_lib:format("expected a SEQUENCE or SET got: ~p", [Ref]);
+format_error(illegal_external_value) ->
+ "illegal value in EXTERNAL type";
format_error({illegal_instance_of,Class}) ->
io_lib:format("using INSTANCE OF on class '~s' is illegal, "
- "because INSTANCE OF may only be used on the class TYPE-IDENTFIER",
+ "because INSTANCE OF may only be used on the class TYPE-IDENTIFIER",
[Class]);
+format_error(illegal_integer_value) ->
+ "expecting an integer value";
+format_error(illegal_object) ->
+ "expecting an object";
+format_error({illegal_object_field, Id}) ->
+ io_lib:format("expecting a class field: ~p",[Id]);
+format_error({illegal_oid,o_id}) ->
+ "illegal OBJECT IDENTIFIER";
+format_error({illegal_oid,rel_oid}) ->
+ "illegal RELATIVE-OID";
format_error(illegal_octet_string_value) ->
"expecting a bstring or an hstring as value for an OCTET STRING";
format_error({illegal_typereference,Name}) ->
io_lib:format("'~p' is used as a typereference, but does not start with an uppercase letter", [Name]);
+format_error(illegal_table_constraint) ->
+ "table constraints may only be applied to CLASS.&field constructs";
+format_error(illegal_value) ->
+ "expecting a value";
+format_error({illegal_value, TYPE}) ->
+ io_lib:format("expecting a ~s value", [TYPE]);
format_error({invalid_fields,Fields,Obj}) ->
io_lib:format("invalid ~s in ~p", [format_fields(Fields),Obj]);
format_error({invalid_bit_number,Bit}) ->
io_lib:format("the bit number '~p' is invalid", [Bit]);
+format_error(invalid_table_constraint) ->
+ "the table constraint is not an object set";
+format_error(invalid_objectset) ->
+ "expecting an object set";
+format_error({implicit_tag_before,Kind}) ->
+ "illegal implicit tag before " ++
+ case Kind of
+ choice -> "'CHOICE'";
+ open_type -> "open type"
+ end;
format_error({missing_mandatory_fields,Fields,Obj}) ->
io_lib:format("missing mandatory ~s in ~p",
[format_fields(Fields),Obj]);
+format_error({missing_table_constraint,Component}) ->
+ io_lib:format("the component '~s' is referenced by a component relation constraint using the '@field-name' notation, but does not have a table constraint",
+ [Component]);
+format_error({missing_id,Id}) ->
+ io_lib:format("expected the mandatory component '~p'", [Id]);
+format_error({missing_ocft,Component}) ->
+ io_lib:format("the component '~s' must be an ObjectClassFieldType (CLASSNAME.&field-name)", [Component]);
+format_error(multiple_uniqs) ->
+ "implementation limitation: only one UNIQUE field is allowed in CLASS";
format_error({namelist_redefinition,Name}) ->
io_lib:format("the name '~s' can not be redefined", [Name]);
+format_error({param_bad_type, Ref}) ->
+ io_lib:format("'~p' is not a parameterized type", [Ref]);
+format_error(param_wrong_number_of_arguments) ->
+ "wrong number of arguments";
+format_error(reversed_range) ->
+ "ranges must be given in increasing order";
+format_error({syntax_duplicated_fields,Fields}) ->
+ io_lib:format("~s must only occur once in the syntax list",
+ [format_fields(Fields)]);
+format_error(syntax_nomatch) ->
+ "unexpected end of object definition";
+format_error({syntax_mandatory_in_optional_group,Name}) ->
+ io_lib:format("the field '&~s' must not be within an optional group since it is not optional",
+ [Name]);
+format_error({syntax_missing_mandatory_fields,Fields}) ->
+ io_lib:format("missing mandatory ~s in the syntax list",
+ [format_fields(Fields)]);
+format_error({syntax_nomatch,Actual}) ->
+ io_lib:format("~s is not the next item allowed according to the defined syntax",
+ [Actual]);
+format_error({syntax_undefined_field,Field}) ->
+ io_lib:format("'&~s' is not a field of the class being defined",
+ [Field]);
format_error({undefined,Name}) ->
io_lib:format("'~s' is referenced, but is not defined", [Name]);
+format_error({undefined_export,Ref}) ->
+ io_lib:format("'~s' is exported but is not defined", [Ref]);
+format_error({undefined_field,FieldName}) ->
+ io_lib:format("the field '&~s' is undefined", [FieldName]);
format_error({undefined_import,Ref,Module}) ->
io_lib:format("'~s' is not exported from ~s", [Ref,Module]);
+format_error({unique_and_default,Field}) ->
+ io_lib:format("the field '&~s' must not have both 'UNIQUE' and 'DEFAULT'",
+ [Field]);
format_error({value_reused,Val}) ->
io_lib:format("the value '~p' is used more than once", [Val]);
+format_error({non_unique_object,Id}) ->
+ io_lib:format("object set with a UNIQUE field value of '~p' is used more than once", [Id]);
format_error(Other) ->
io_lib:format("~p", [Other]).
format_fields([F]) ->
- io_lib:format("field &~s", [F]);
+ io_lib:format("field '&~s'", [F]);
format_fields([H|T]) ->
- [io_lib:format("fields &~s", [H])|
- [io_lib:format(", &~s", [F]) || F <- T]].
-
-error({_,{structured_error,_,_,_}=SE,_}) ->
- SE;
-error({export,Msg,#state{mname=Mname,type=Ref,tname=Typename}}) ->
- Pos = Ref#'Externaltypereference'.pos,
- io:format("asn1error:~p:~p:~p~n~p~n",[Pos,Mname,Typename,Msg]),
- {error,{export,Pos,Mname,Typename,Msg}};
-% error({type,{Msg1,Msg2},#state{mname=Mname,type=Type,tname=Typename}})
-% when is_record(Type,typedef) ->
-% io:format("asn1error:~p:~p:~p ~p~n",
-% [Type#typedef.pos,Mname,Typename,Msg1]),
-% {error,{type,Type#typedef.pos,Mname,Typename,Msg1,Msg2}};
-error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}})
- when is_record(Type,type) ->
- io:format("asn1error:~p:~p~n~p~n",
- [Mname,Typename,Msg]),
- {error,{type,Mname,Typename,Msg}};
-error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}})
- when is_record(Type,typedef) ->
- io:format("asn1error:~p:~p:~p~n~p~n",
- [Type#typedef.pos,Mname,Typename,Msg]),
- {error,{type,Type#typedef.pos,Mname,Typename,Msg}};
-error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}})
- when is_record(Type,ptypedef) ->
- io:format("asn1error:~p:~p:~p~n~p~n",
- [Type#ptypedef.pos,Mname,Typename,Msg]),
- {error,{type,Type#ptypedef.pos,Mname,Typename,Msg}};
-error({type,Msg,#state{mname=Mname,value=Value,vname=Valuename}})
- when is_record(Value,valuedef) ->
- io:format("asn1error:~p:~p:~p~n~p~n",[Value#valuedef.pos,Mname,Valuename,Msg]),
- {error,{type,Value#valuedef.pos,Mname,Valuename,Msg}};
-error({type,Msg,#state{mname=Mname,type=Type,tname=Typename}})
- when is_record(Type,pobjectdef) ->
- io:format("asn1error:~p:~p:~p~n~p~n",
- [Type#pobjectdef.pos,Mname,Typename,Msg]),
- {error,{type,Type#pobjectdef.pos,Mname,Typename,Msg}};
-error({value,Msg,#state{mname=Mname,value=Value,vname=Valuename}})
- when is_record(Value,valuedef) ->
- io:format("asn1error:~p:~p:~p~n~p~n",[Value#valuedef.pos,Mname,Valuename,Msg]),
- {error,{value,Value#valuedef.pos,Mname,Valuename,Msg}};
-error({Other,Msg,#state{mname=Mname,value=#valuedef{pos=Pos},vname=Valuename}}) ->
- io:format("asn1error:~p:~p:~p~n~p~n",[Pos,Mname,Valuename,Msg]),
- {error,{Other,Pos,Mname,Valuename,Msg}};
-error({Other,Msg,#state{mname=Mname,type=#typedef{pos=Pos},tname=Typename}}) ->
- io:format("asn1error:~p:~p:~p~n~p~n",[Pos,Mname,Typename,Msg]),
- {error,{Other,Pos,Mname,Typename,Msg}};
-error({Other,Msg,#state{mname=Mname,type=#classdef{pos=Pos},tname=Typename}}) ->
- io:format("asn1error:~p:~p:~p~n~p~n",[Pos,Mname,Typename,Msg]),
- {error,{Other,Pos,Mname,Typename,Msg}};
-error({Other,Msg,#state{mname=Mname,type=Type,tname=Typename}}) ->
- io:format("asn1error:~p:~p:~p~n~p~n",[asn1ct:get_pos_of_def(Type),Mname,Typename,Msg]),
- {error,{Other,asn1ct:get_pos_of_def(Type),Mname,Typename,Msg}}.
+ [io_lib:format("fields '&~s'", [H])|
+ [io_lib:format(", '&~s'", [F]) || F <- T]].
+
+format_elements([H1,H2|T]) ->
+ [io_lib:format("~p, ", [H1])|format_elements([H2|T])];
+format_elements([H]) ->
+ io_lib:format("~p", [H]).
include_default_type(Module) ->
NameAbsList = default_type_list(),
@@ -6953,62 +6039,62 @@ default_type_list() ->
].
-include_default_class(S,Module) ->
- NameAbsList = default_class_list(S),
- include_default_class1(Module,NameAbsList).
+include_default_class(S, Module) ->
+ _ = [include_default_class1(S, Module, ClassDef) ||
+ ClassDef <- default_class_list()],
+ ok.
-include_default_class1(_,[]) ->
- ok;
-include_default_class1(Module,[{Name,TS}|Rest]) ->
- case asn1_db:dbget(Module,Name) of
+include_default_class1(S, Module, {Name,Ts0}) ->
+ case asn1_db:dbget(Module, Name) of
undefined ->
- C = #classdef{checked=true,module=Module,name=Name,
- typespec=TS},
- asn1_db:dbput(Module,Name,C);
- _ -> ok
- end,
- include_default_class1(Module,Rest).
+ #objectclass{fields=Fields,
+ syntax={'WITH SYNTAX',Syntax0}} = Ts0,
+ Syntax = preprocess_syntax(S, Syntax0, Fields),
+ Ts = Ts0#objectclass{syntax={preprocessed_syntax,Syntax}},
+ C = #classdef{checked=true,module=Module,
+ name=Name,typespec=Ts},
+ asn1_db:dbput(Module, Name, C);
+ _ ->
+ ok
+ end.
-default_class_list(S) ->
+default_class_list() ->
[{'TYPE-IDENTIFIER',
- {objectclass,
- [{fixedtypevaluefield,
- id,
- #type{tag=?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER),
- def='OBJECT IDENTIFIER'},
- 'UNIQUE',
- 'MANDATORY'},
- {typefield,'Type','MANDATORY'}],
- {'WITH SYNTAX',
- [{typefieldreference,'Type'},
- 'IDENTIFIED',
- 'BY',
- {valuefieldreference,id}]}}},
+ #objectclass{fields=[{fixedtypevaluefield,
+ id,
+ #type{tag=[?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER)],
+ def='OBJECT IDENTIFIER'},
+ 'UNIQUE',
+ 'MANDATORY'},
+ {typefield,'Type','MANDATORY'}],
+ syntax={'WITH SYNTAX',
+ [{typefieldreference,'Type'},
+ 'IDENTIFIED',
+ 'BY',
+ {valuefieldreference,id}]}}},
{'ABSTRACT-SYNTAX',
- {objectclass,
- [{fixedtypevaluefield,
- id,
- #type{tag=?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER),
- def='OBJECT IDENTIFIER'},
- 'UNIQUE',
- 'MANDATORY'},
- {typefield,'Type','MANDATORY'},
- {fixedtypevaluefield,
- property,
- #type{tag=?TAG_PRIMITIVE(?N_BIT_STRING),
- def={'BIT STRING',[]}},
- undefined,
- {'DEFAULT',
- [0,1,0]}}],
- {'WITH SYNTAX',
- [{typefieldreference,'Type'},
- 'IDENTIFIED',
- 'BY',
- {valuefieldreference,id},
- ['HAS',
- 'PROPERTY',
- {valuefieldreference,property}]]}}}].
-
+ #objectclass{fields=[{fixedtypevaluefield,
+ id,
+ #type{tag=[?TAG_PRIMITIVE(?N_OBJECT_IDENTIFIER)],
+ def='OBJECT IDENTIFIER'},
+ 'UNIQUE',
+ 'MANDATORY'},
+ {typefield,'Type','MANDATORY'},
+ {fixedtypevaluefield,
+ property,
+ #type{tag=[?TAG_PRIMITIVE(?N_BIT_STRING)],
+ def={'BIT STRING',[]}},
+ undefined,
+ {'DEFAULT',
+ [0,1,0]}}],
+ syntax={'WITH SYNTAX',
+ [{typefieldreference,'Type'},
+ 'IDENTIFIED',
+ 'BY',
+ {valuefieldreference,id},
+ ['HAS',
+ 'PROPERTY',
+ {valuefieldreference,property}]]}}}].
new_reference_name(Name) ->
case get(asn1_reference) of
@@ -7037,8 +6123,9 @@ insert_once(S,Tab,Key) ->
skipped
end.
-check_fold(S, [H|T], Check) ->
- Type = asn1_db:dbget(S#state.mname, H),
+check_fold(S0, [H|T], Check) ->
+ Type = asn1_db:dbget(S0#state.mname, H),
+ S = S0#state{error_context=Type},
case Check(S, H, Type) of
ok ->
check_fold(S, T, Check);
@@ -7047,5 +6134,19 @@ check_fold(S, [H|T], Check) ->
end;
check_fold(_, [], Check) when is_function(Check, 3) -> [].
+error_value(Value) when is_integer(Value) -> Value;
+error_value(Value) when is_atom(Value) -> Value;
+error_value(#type{def=Value}) when is_atom(Value) -> Value;
+error_value(#type{def=Value}) -> error_value(Value);
+error_value(RefOrType) ->
+ try name_of_def(RefOrType) of
+ Name -> Name
+ catch _:_ ->
+ case get_datastr_name(RefOrType) of
+ undefined -> RefOrType;
+ Name -> Name
+ end
+ end.
+
name_of_def(#'Externaltypereference'{type=N}) -> N;
name_of_def(#'Externalvaluereference'{value=N}) -> N.
diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl
index 5fadd0495a..820d19b85c 100644
--- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl
+++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -234,7 +234,7 @@ gen_decode_sequence(Erules,Typename,D) when is_record(D,type) ->
asn1ct_name:new(rb),
emit([" {'",RecordName,"'}.",nl,nl]);
{LeadingAttrTerm,PostponedDecArgs} ->
- emit([com,nl,nl]),
+ emit([nl]),
case {LeadingAttrTerm,PostponedDecArgs} of
{[],[]} ->
ok;
@@ -413,7 +413,7 @@ gen_decode_set(Erules,Typename,D) when is_record(D,type) ->
%% return value as record
emit([" {'",RecordName,"'}.",nl]);
{LeadingAttrTerm,PostponedDecArgs} ->
- emit([com,nl,nl]),
+ emit([nl]),
case {LeadingAttrTerm,PostponedDecArgs} of
{[],[]} ->
ok;
@@ -617,18 +617,20 @@ gen_dec_sequence_call1(Erules,TopType,[#'ComponentType'{name=Cname,typespec=Type
{LA,PostponedDec} =
gen_dec_component(Erules,TopType,Cname,Tags,Type,Num,Prop,
Ext,DecObjInf),
+ emit([com,nl]),
case Rest of
[] ->
{LA ++ LeadingAttrAcc,PostponedDec ++ ArgsAcc};
_ ->
- emit([com,nl]),
asn1ct_name:new(bytes),
gen_dec_sequence_call1(Erules,TopType,Rest,Num+1,Ext,DecObjInf,
LA++LeadingAttrAcc,PostponedDec++ArgsAcc)
end;
gen_dec_sequence_call1(_Erules,_TopType,[],1,_,_,_,_) ->
- no_terms.
+ no_terms;
+gen_dec_sequence_call1(_, _, [], _Num, _, _, LA, PostponedDec) ->
+ {LA, PostponedDec}.
gen_dec_sequence_call2(_Erules,_TopType, {[], [], []}, _Ext,_DecObjInf) ->
no_terms;
@@ -643,7 +645,6 @@ gen_dec_sequence_call2(Erules,TopType,{Root1,EList,Root2},_Ext,DecObjInf) ->
%% TagList is the tags of Root2 elements from the first up to and
%% including the first mandatory element.
TagList = get_root2_taglist(Root2,[]),
- emit({com,nl}),
emit([{curr,tlv}," = ",
{call,ber,skip_ExtensionAdditions,
[{prev,tlv},{asis,TagList}]},com,nl]),
diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl
index a91404ed54..0bc6688a49 100644
--- a/lib/asn1/src/asn1ct_constructed_per.erl
+++ b/lib/asn1/src/asn1ct_constructed_per.erl
@@ -410,12 +410,11 @@ gen_dec_open_type(Erule, Val, {Xmod,Xtype}, LeadingAttr,
#classdef{typespec=ClassDef} = asn1_db:dbget(ClMod, ClType),
#objectclass{fields=ClassFields} = ClassDef,
Extensible = lists:member('EXTENSIONMARK', ObjSet1),
- ObjSet2 = [{Key,fix_object_code(Name, Code, ClassFields)} ||
- {_,Key,Code} <- ObjSet1],
- ObjSet = lists:sort([P || {_,B}=P <- ObjSet2, B =/= none]),
+ Typename = [Name,ClType],
+ ObjSet = index_object_set(Erule, ClType, Name,
+ ObjSet1, ClassFields),
Key = erlang:md5(term_to_binary({decode,ObjSet,RestFieldNames,
Prop,Extensible})),
- Typename = [Name,ClType],
Gen = fun(_Fd, N) ->
dec_objset_optional(N, Prop),
dec_objset(Erule, N, ObjSet, RestFieldNames, Typename),
@@ -467,46 +466,15 @@ dec_objset_2(Erule, Obj, RestFields0, Typename) ->
Imm = asn1ct_gen_per:gen_dec_imm(Erule, Type),
{Term,_} = asn1ct_imm:dec_slim_cg(Imm, 'Bytes'),
emit([com,nl,Term]);
- #typedef{name={constructed,bif},typespec=Def} ->
- InnerType = asn1ct_gen:get_inner(Def#type.def),
- case InnerType of
- 'CHOICE' ->
- asn1ct_name:start(),
- asn1ct_name:new(bytes),
- {'CHOICE',CompList} = Def#type.def,
- Ext = extensible_enc(CompList),
- emit(["{Result,_} = begin",nl]),
- gen_dec_choice(Erule, Typename, CompList, Ext),
- emit([nl,
- "end",com,nl,
- "Result"]);
- 'SET' ->
- Imm0 = gen_dec_constructed_imm(Erule, Typename, Def),
- Imm = opt_imm(Imm0),
- asn1ct_name:start(),
- emit(["{Result,_} = begin",nl]),
- emit_gen_dec_imm(Imm),
- emit([nl,
- "end",com,nl,
- "Result"]);
- 'SET OF' ->
- asn1ct_name:start(),
- do_gen_decode_sof(Erule, Typename, 'SET OF',
- Def, false);
- 'SEQUENCE' ->
- Imm0 = gen_dec_constructed_imm(Erule, Typename, Def),
- Imm = opt_imm(Imm0),
- asn1ct_name:start(),
- emit(["{Result,_} = begin",nl]),
- emit_gen_dec_imm(Imm),
- emit([nl,
- "end",com,nl,
- "Result"]);
- 'SEQUENCE OF' ->
- asn1ct_name:start(),
- do_gen_decode_sof(Erule, Typename, 'SEQUENCE OF',
- Def, false)
- end;
+ #typedef{name={constructed,bif},typespec=Type}=Def ->
+ Prefix = "dec_outlined_",
+ Key = {dec_outlined,Def},
+ Gen = fun(_Fd, Name) ->
+ gen_dec_obj(Erule, Name, Typename, Type)
+ end,
+ Func = asn1ct_func:call_gen(Prefix, Key, Gen),
+ emit(["{Term,_} = ",{asis,Func},"(Bytes)",com,nl,
+ "Term"]);
#typedef{name=Type} ->
emit(["{Result,_} = ",{asis,enc_func("dec_", Type)},"(Bytes),",nl,
"Result"]);
@@ -531,6 +499,12 @@ dec_objset_2(Erule, Obj, RestFields0, Typename) ->
end
end.
+gen_dec_obj(Erules, Name, Typename, Type) ->
+ emit([{asis,Name},"(Bytes) ->",nl]),
+ InnerType = asn1ct_gen:get_inner(Type#type.def),
+ asn1ct_gen:gen_decode_constructed(Erules, Typename,
+ InnerType, Type).
+
gen_encode_choice(Erule, TopType, D) ->
asn1ct_name:start(),
Imm = gen_encode_choice_imm(Erule, TopType, D),
@@ -595,10 +569,10 @@ gen_encode_sof_imm(Erule, Typename, SeqOrSetOf, #type{}=D) ->
gen_decode_sof(Erules, Typename, SeqOrSetOf, #type{}=D) ->
asn1ct_name:start(),
- do_gen_decode_sof(Erules, Typename, SeqOrSetOf, D, true),
+ do_gen_decode_sof(Erules, Typename, SeqOrSetOf, D),
emit([".",nl,nl]).
-do_gen_decode_sof(Erules, Typename, SeqOrSetOf, D, NeedRest) ->
+do_gen_decode_sof(Erules, Typename, SeqOrSetOf, D) ->
{_SeqOrSetOf,ComponentType} = D#type.def,
SizeConstraint = asn1ct_imm:effective_constraint(bitstring,
D#type.constraint),
@@ -610,12 +584,11 @@ do_gen_decode_sof(Erules, Typename, SeqOrSetOf, D, NeedRest) ->
""
end,
{Num,Buf} = gen_decode_length(SizeConstraint, Erules),
- Key = erlang:md5(term_to_binary({Typename,SeqOrSetOf,
- ComponentType,NeedRest})),
+ Key = erlang:md5(term_to_binary({Typename,SeqOrSetOf,ComponentType})),
Gen = fun(_Fd, Name) ->
gen_decode_sof_components(Erules, Name,
Typename, SeqOrSetOf,
- ComponentType, NeedRest)
+ ComponentType)
end,
F = asn1ct_func:call_gen("dec_components", Key, Gen),
emit([",",nl,
@@ -629,7 +602,7 @@ gen_decode_length(Constraint, Erule) ->
Imm = asn1ct_imm:per_dec_length(Constraint, true, is_aligned(Erule)),
asn1ct_imm:dec_slim_cg(Imm, "Bytes").
-gen_decode_sof_components(Erule, Name, Typename, SeqOrSetOf, Cont, NeedRest) ->
+gen_decode_sof_components(Erule, Name, Typename, SeqOrSetOf, Cont) ->
{ObjFun,ObjFun_Var} =
case Cont#type.tablecinf of
[{objfun,_}|_R] ->
@@ -637,14 +610,8 @@ gen_decode_sof_components(Erule, Name, Typename, SeqOrSetOf, Cont, NeedRest) ->
_ ->
{"",""}
end,
- case NeedRest of
- false ->
- emit([{asis,Name},"(0, _Bytes",ObjFun_Var,", Acc) ->",nl,
- "lists:reverse(Acc);",nl]);
- true ->
- emit([{asis,Name},"(0, Bytes",ObjFun_Var,", Acc) ->",nl,
- "{lists:reverse(Acc),Bytes};",nl])
- end,
+ emit([{asis,Name},"(0, Bytes",ObjFun_Var,", Acc) ->",nl,
+ "{lists:reverse(Acc),Bytes};",nl]),
emit([{asis,Name},"(Num, Bytes",ObjFun,", Acc) ->",nl,
"{Term,Remain} = "]),
Constructed_Suffix = asn1ct_gen:constructed_suffix(SeqOrSetOf,
@@ -1024,11 +991,12 @@ enc_var_type_call(Erule, Name, RestFieldNames,
#classdef{typespec=ClassDef} = asn1_db:dbget(ClMod, ClType),
#objectclass{fields=ClassFields} = ClassDef,
Extensible = lists:member('EXTENSIONMARK', ObjSet1),
- ObjSet2 = [{Key,fix_object_code(Name, Code, ClassFields)} ||
- {_,Key,Code} <- ObjSet1],
- ObjSet = lists:sort([P || {_,B}=P <- ObjSet2, B =/= none]),
+ ObjSet = index_object_set(Erule, ClType, Name,
+ ObjSet1, ClassFields),
Key = erlang:md5(term_to_binary({encode,ObjSet,RestFieldNames,Extensible})),
- Imm = enc_objset_imm(Erule, Name, ObjSet, RestFieldNames, Extensible),
+ TypeName = [ClType,Name],
+ Imm = enc_objset_imm(Erule, TypeName, Name, ObjSet,
+ RestFieldNames, Extensible),
Lambda = {lambda,[{var,"Val"},{var,"Id"}],Imm},
Gen = fun(_Fd, N) ->
Aligned = is_aligned(Erule),
@@ -1039,11 +1007,27 @@ enc_var_type_call(Erule, Name, RestFieldNames,
Prefix = lists:concat(["enc_os_",Name]),
[{call_gen,Prefix,Key,Gen,Lambda,[Val,Fun]}].
-fix_object_code(Name, [{Name,B}|_], _ClassFields) ->
- B;
-fix_object_code(Name, [_|T], ClassFields) ->
- fix_object_code(Name, T, ClassFields);
-fix_object_code(Name, [], ClassFields) ->
+index_object_set(_Erules, _ClType, Name, Set0, ClassFields) ->
+ Set = index_object_set_1(Name, Set0, ClassFields),
+ lists:sort(Set).
+
+index_object_set_1(Name, [{_,Key,Code}|T], ClassFields) ->
+ case index_object_set_2(Name, Code, ClassFields) of
+ none ->
+ index_object_set_1(Name, T, ClassFields);
+ Type ->
+ [{Key,Type}|index_object_set_1(Name, T, ClassFields)]
+ end;
+index_object_set_1(Name, [_|T], ClassFields) ->
+ index_object_set_1(Name, T, ClassFields);
+index_object_set_1(_, [], _) ->
+ [].
+
+index_object_set_2(Name, [{Name,Type}|_], _ClassFields) ->
+ Type;
+index_object_set_2(Name, [_|T], ClassFields) ->
+ index_object_set_2(Name, T, ClassFields);
+index_object_set_2(Name, [], ClassFields) ->
case lists:keyfind(Name, 2, ClassFields) of
{typefield,Name,'OPTIONAL'} ->
none;
@@ -1059,7 +1043,8 @@ fix_object_code(Name, [], ClassFields) ->
end
end.
-enc_objset_imm(Erule, Component, ObjSet, RestFieldNames, Extensible) ->
+enc_objset_imm(Erule, TypeName, Component, ObjSet,
+ RestFieldNames, Extensible) ->
Aligned = is_aligned(Erule),
E = {error,
fun() ->
@@ -1070,7 +1055,7 @@ enc_objset_imm(Erule, Component, ObjSet, RestFieldNames, Extensible) ->
end},
[{'cond',
[[{eq,{var,"Id"},Key}|
- enc_obj(Erule, Obj, RestFieldNames, Aligned)] ||
+ enc_obj(Erule, Obj, TypeName, RestFieldNames, Aligned)] ||
{Key,Obj} <- ObjSet] ++
[['_',case Extensible of
false ->
@@ -1086,24 +1071,18 @@ enc_objset_imm(Erule, Component, ObjSet, RestFieldNames, Extensible) ->
end
end]]}].
-enc_obj(Erule, Obj, RestFieldNames0, Aligned) ->
+enc_obj(Erule, Obj, TypeName, RestFieldNames0, Aligned) ->
+ Val = {var,"Val"},
case Obj of
+ #typedef{name={constructed,bif},typespec=Type}=Def ->
+ Prefix = "enc_outlined_",
+ Key = {enc_outlined,Def},
+ Gen = fun(_Fd, Name) ->
+ gen_enc_obj(Erule, Name, TypeName, Type)
+ end,
+ [{call_gen,Prefix,Key,Gen,undefined,[Val]}];
#typedef{name={primitive,bif},typespec=Def} ->
asn1ct_gen_per:gen_encode_prim_imm({var,"Val"}, Def, Aligned);
- #typedef{name={constructed,bif},typespec=Def} ->
- InnerType = asn1ct_gen:get_inner(Def#type.def),
- case InnerType of
- 'CHOICE' ->
- gen_encode_choice_imm(Erule, name, Def);
- 'SET' ->
- gen_encode_constructed_imm(Erule, name, Def);
- 'SET OF' ->
- gen_encode_sof_imm(Erule, name, InnerType, Def);
- 'SEQUENCE' ->
- gen_encode_constructed_imm(Erule, name, Def);
- 'SEQUENCE OF' ->
- gen_encode_sof_imm(Erule, name, InnerType, Def)
- end;
#typedef{name=Type} ->
[{apply,{local,enc_func(Type),Type},[{var,"Val"}]}];
#'Externalvaluereference'{module=Mod,value=Value} ->
@@ -1112,7 +1091,8 @@ enc_obj(Erule, Obj, RestFieldNames0, Aligned) ->
{object,_,Fields} = Def,
[NextField|RestFieldNames] = RestFieldNames0,
{NextField,Typedef} = lists:keyfind(NextField, 1, Fields),
- enc_obj(Erule, Typedef, RestFieldNames, Aligned)
+ enc_obj(Erule, Typedef, TypeName,
+ RestFieldNames, Aligned)
end;
#'Externaltypereference'{module=Mod,type=Type} ->
Func = enc_func(Type),
@@ -1124,6 +1104,11 @@ enc_obj(Erule, Obj, RestFieldNames0, Aligned) ->
end
end.
+gen_enc_obj(Erules, Name, Typename, Type) ->
+ emit([{asis,Name},"(Val) ->",nl]),
+ InnerType = asn1ct_gen:get_inner(Type#type.def),
+ asn1ct_gen:gen_encode_constructed(Erules, Typename,
+ InnerType, Type).
gen_dec_components_call(Erule, TopType, {Root,ExtList},
DecInfObj, Ext, NumberOfOptionals) ->
diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl
index 450d309688..d3c1f34821 100644
--- a/lib/asn1/src/asn1ct_gen.erl
+++ b/lib/asn1/src/asn1ct_gen.erl
@@ -531,34 +531,30 @@ gen_part_decode_funcs({primitive,bif},_TypeName,
gen_part_decode_funcs(WhatKind,_TypeName,{_,Directive,_,_}) ->
throw({error,{asn1,{"Not implemented yet",WhatKind," partial incomplete directive:",Directive}}}).
-
-gen_types(Erules,Tname,{RootL1,ExtList,RootL2})
+%% EncDec = 'gen_encode' | 'gen_decode'
+gen_types(Erules, Tname, {RootL1,ExtList,RootL2}, EncDec)
when is_list(RootL1), is_list(RootL2) ->
- gen_types(Erules,Tname,RootL1),
- Rtmod = ct_gen_module(Erules),
- gen_types(Erules,Tname,Rtmod:extaddgroup2sequence(ExtList)),
- gen_types(Erules,Tname,RootL2);
-gen_types(Erules,Tname,{RootList,ExtList}) when is_list(RootList) ->
- gen_types(Erules,Tname,RootList),
+ gen_types(Erules, Tname, RootL1, EncDec),
Rtmod = ct_gen_module(Erules),
- gen_types(Erules,Tname,Rtmod:extaddgroup2sequence(ExtList));
-gen_types(Erules,Tname,[{'EXTENSIONMARK',_,_}|Rest]) ->
- gen_types(Erules,Tname,Rest);
-gen_types(Erules,Tname,[ComponentType|Rest]) ->
+ gen_types(Erules, Tname, Rtmod:extaddgroup2sequence(ExtList), EncDec),
+ gen_types(Erules, Tname, RootL2, EncDec);
+gen_types(Erules, Tname, {RootList,ExtList}, EncDec) when is_list(RootList) ->
+ gen_types(Erules, Tname, RootList, EncDec),
Rtmod = ct_gen_module(Erules),
+ gen_types(Erules, Tname, Rtmod:extaddgroup2sequence(ExtList), EncDec);
+gen_types(Erules, Tname, [{'EXTENSIONMARK',_,_}|T], EncDec) ->
+ gen_types(Erules, Tname, T, EncDec);
+gen_types(Erules, Tname, [ComponentType|T], EncDec) ->
asn1ct_name:clear(),
- Rtmod:gen_encode(Erules,Tname,ComponentType),
- asn1ct_name:clear(),
- Rtmod:gen_decode(Erules,Tname,ComponentType),
- gen_types(Erules,Tname,Rest);
-gen_types(_,_,[]) ->
- true;
-gen_types(Erules,Tname,Type) when is_record(Type,type) ->
Rtmod = ct_gen_module(Erules),
+ Rtmod:EncDec(Erules, Tname, ComponentType),
+ gen_types(Erules, Tname, T, EncDec);
+gen_types(_, _, [], _) ->
+ ok;
+gen_types(Erules, Tname, #type{}=Type, EncDec) ->
asn1ct_name:clear(),
- Rtmod:gen_encode(Erules,Tname,Type),
- asn1ct_name:clear(),
- Rtmod:gen_decode(Erules,Tname,Type).
+ Rtmod = ct_gen_module(Erules),
+ Rtmod:EncDec(Erules, Tname, Type).
%% VARIOUS GENERATOR STUFF
%% *************************************************
@@ -599,25 +595,25 @@ gen_encode_constructed(Erules,Typename,InnerType,D) when is_record(D,type) ->
'SET' ->
Rtmod:gen_encode_set(Erules,Typename,D),
#'SET'{components=Components} = D#type.def,
- gen_types(Erules,Typename,Components);
+ gen_types(Erules, Typename, Components, gen_encode);
'SEQUENCE' ->
Rtmod:gen_encode_sequence(Erules,Typename,D),
#'SEQUENCE'{components=Components} = D#type.def,
- gen_types(Erules,Typename,Components);
+ gen_types(Erules, Typename, Components, gen_encode);
'CHOICE' ->
Rtmod:gen_encode_choice(Erules,Typename,D),
{_,Components} = D#type.def,
- gen_types(Erules,Typename,Components);
+ gen_types(Erules, Typename, Components, gen_encode);
'SEQUENCE OF' ->
Rtmod:gen_encode_sof(Erules,Typename,InnerType,D),
{_,Type} = D#type.def,
NameSuffix = asn1ct_gen:constructed_suffix(InnerType,Type#type.def),
- gen_types(Erules,[NameSuffix|Typename],Type);
+ gen_types(Erules, [NameSuffix|Typename], Type, gen_encode);
'SET OF' ->
Rtmod:gen_encode_sof(Erules,Typename,InnerType,D),
{_,Type} = D#type.def,
NameSuffix = asn1ct_gen:constructed_suffix(InnerType,Type#type.def),
- gen_types(Erules,[NameSuffix|Typename],Type);
+ gen_types(Erules, [NameSuffix|Typename], Type, gen_encode);
_ ->
exit({nyi,InnerType})
end;
@@ -630,20 +626,29 @@ gen_decode_constructed(Erules,Typename,InnerType,D) when is_record(D,type) ->
asn1ct:step_in_constructed(), %% updates namelist for exclusive decode
case InnerType of
'SET' ->
- Rtmod:gen_decode_set(Erules,Typename,D);
+ Rtmod:gen_decode_set(Erules,Typename,D),
+ #'SET'{components=Components} = D#type.def,
+ gen_types(Erules, Typename, Components, gen_decode);
'SEQUENCE' ->
- Rtmod:gen_decode_sequence(Erules,Typename,D);
+ Rtmod:gen_decode_sequence(Erules,Typename,D),
+ #'SEQUENCE'{components=Components} = D#type.def,
+ gen_types(Erules, Typename, Components, gen_decode);
'CHOICE' ->
- Rtmod:gen_decode_choice(Erules,Typename,D);
+ Rtmod:gen_decode_choice(Erules,Typename,D),
+ {_,Components} = D#type.def,
+ gen_types(Erules, Typename, Components, gen_decode);
'SEQUENCE OF' ->
- Rtmod:gen_decode_sof(Erules,Typename,InnerType,D);
+ Rtmod:gen_decode_sof(Erules,Typename,InnerType,D),
+ {_,#type{def=Def}=Type} = D#type.def,
+ NameSuffix = asn1ct_gen:constructed_suffix(InnerType, Def),
+ gen_types(Erules, [NameSuffix|Typename], Type, gen_decode);
'SET OF' ->
- Rtmod:gen_decode_sof(Erules,Typename,InnerType,D);
- _ ->
- exit({nyi,InnerType})
+ Rtmod:gen_decode_sof(Erules,Typename,InnerType,D),
+ {_,#type{def=Def}=Type} = D#type.def,
+ NameSuffix = asn1ct_gen:constructed_suffix(InnerType, Def),
+ gen_types(Erules, [NameSuffix|Typename], Type, gen_decode)
end;
-
gen_decode_constructed(Erules,Typename,InnerType,D) when is_record(D,typedef) ->
gen_decode_constructed(Erules,Typename,InnerType,D#typedef.typespec).
diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl
index e51b0898be..37413298a7 100644
--- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl
+++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2014. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -24,7 +24,7 @@
-include("asn1_records.hrl").
--export([decode_class/1, decode_type/1]).
+-export([decode_class/1]).
-export([gen_encode/2,gen_encode/3,gen_decode/2,gen_decode/3]).
-export([gen_encode_prim/4]).
-export([gen_dec_prim/3]).
@@ -278,8 +278,7 @@ emit_enc_enumerated_cases(L, Tags) ->
emit_enc_enumerated_cases(L, Tags, noext).
emit_enc_enumerated_cases([{EnumName,EnumVal}|T], Tags, Ext) ->
- Bytes = encode_pos_integer(EnumVal, []),
- Len = length(Bytes),
+ {Bytes,Len} = encode_integer(EnumVal),
emit([{asis,EnumName}," -> ",
{call,ber,encode_tags,[Tags,{asis,Bytes},Len]},";",nl]),
emit_enc_enumerated_cases(T, Tags, Ext);
@@ -288,10 +287,25 @@ emit_enc_enumerated_cases([], _Tags, _Ext) ->
emit([{curr,enumval}," -> exit({error,{asn1, {enumerated_not_in_range,",{curr, enumval},"}}})"]),
emit([nl,"end"]).
-encode_pos_integer(0, [B|_Acc] = L) when B < 128 ->
+encode_integer(Val) ->
+ Bytes =
+ if
+ Val >= 0 ->
+ encode_integer_pos(Val, []);
+ true ->
+ encode_integer_neg(Val, [])
+ end,
+ {Bytes,length(Bytes)}.
+
+encode_integer_pos(0, [B|_Acc]=L) when B < 128 ->
L;
-encode_pos_integer(N, Acc) ->
- encode_pos_integer(N bsr 8, [N band 255|Acc]).
+encode_integer_pos(N, Acc) ->
+ encode_integer_pos((N bsr 8), [N band 16#ff| Acc]).
+
+encode_integer_neg(-1, [B1|_T]=L) when B1 > 127 ->
+ L;
+encode_integer_neg(N, Acc) ->
+ encode_integer_neg(N bsr 8, [N band 16#ff|Acc]).
%%===============================================================================
%%===============================================================================
@@ -1179,23 +1193,25 @@ gen_objset_enc(_,_,{unique,undefined},_,_,_,_,_) ->
gen_objset_enc(Erules, ObjSetName, UniqueName,
[{ObjName,Val,Fields}|T], ClName, ClFields,
NthObj,Acc)->
- emit(["'getenc_",ObjSetName,"'(",{asis,Val},") ->",nl]),
CurrMod = get(currmod),
{InternalFunc,NewNthObj}=
case ObjName of
{no_mod,no_name} ->
- gen_inlined_enc_funs(Fields,ClFields,ObjSetName,NthObj);
+ gen_inlined_enc_funs(Fields, ClFields, ObjSetName, Val, NthObj);
{CurrMod,Name} ->
- emit({" fun 'enc_",Name,"'/3"}),
+ emit(["'getenc_",ObjSetName,"'(",{asis,Val},") ->",nl,
+ " fun 'enc_",Name,"'/3;",nl]),
{[],NthObj};
{ModuleName,Name} ->
+ emit(["'getenc_",ObjSetName,"'(",{asis,Val},") ->",nl]),
emit_ext_fun(enc,ModuleName,Name),
+ emit([";",nl]),
{[],NthObj};
_ ->
- emit({" fun 'enc_",ObjName,"'/3"}),
+ emit(["'getenc_",ObjSetName,"'(",{asis,Val},") ->",nl,
+ " fun 'enc_",ObjName,"'/3;",nl]),
{[],NthObj}
end,
- emit({";",nl}),
gen_objset_enc(Erules, ObjSetName, UniqueName, T, ClName, ClFields,
NewNthObj, InternalFunc ++ Acc);
%% See X.681 Annex E for the following case
@@ -1223,13 +1239,14 @@ emit_default_getenc(ObjSetName,UniqueName) ->
%% gen_inlined_enc_funs for each object iterates over all fields of a
%% class, and for each typefield it checks if the object has that
%% field and emits the proper code.
-gen_inlined_enc_funs(Fields, [{typefield,_,_}|_]=T, ObjSetName, NthObj) ->
- emit([indent(3),"fun(Type, Val, _RestPrimFieldName) ->",nl,
+gen_inlined_enc_funs(Fields, [{typefield,_,_}|_]=T, ObjSetName, Val, NthObj) ->
+ emit(["'getenc_",ObjSetName,"'(",{asis,Val},") ->",nl,
+ indent(3),"fun(Type, Val, _RestPrimFieldName) ->",nl,
indent(6),"case Type of",nl]),
gen_inlined_enc_funs1(Fields, T, ObjSetName, [], NthObj, []);
-gen_inlined_enc_funs(Fields,[_|Rest],ObjSetName,NthObj) ->
- gen_inlined_enc_funs(Fields,Rest,ObjSetName,NthObj);
-gen_inlined_enc_funs(_,[],_,NthObj) ->
+gen_inlined_enc_funs(Fields, [_|Rest], ObjSetName, Val, NthObj) ->
+ gen_inlined_enc_funs(Fields, Rest, ObjSetName, Val, NthObj);
+gen_inlined_enc_funs(_, [], _, _, NthObj) ->
{[],NthObj}.
gen_inlined_enc_funs1(Fields, [{typefield,Name,_}|Rest], ObjSetName,
@@ -1276,7 +1293,7 @@ gen_inlined_enc_funs1(Fields,[_|Rest], ObjSetName, Sep, NthObj, Acc)->
gen_inlined_enc_funs1(Fields, Rest, ObjSetName, Sep, NthObj, Acc);
gen_inlined_enc_funs1(_, [], _, _, NthObj, Acc) ->
emit([nl,indent(6),"end",nl,
- indent(3),"end"]),
+ indent(3),"end;",nl]),
{Acc,NthObj}.
emit_enc_open_type(I) ->
@@ -1358,23 +1375,25 @@ gen_objset_dec(_,_,{unique,undefined},_,_,_,_) ->
ok;
gen_objset_dec(Erules, ObjSName, UniqueName, [{ObjName,Val,Fields}|T],
ClName, ClFields, NthObj)->
- emit(["'getdec_",ObjSName,"'(",{asis,Val},") ->",nl]),
CurrMod = get(currmod),
NewNthObj=
case ObjName of
{no_mod,no_name} ->
- gen_inlined_dec_funs(Fields,ClFields,ObjSName,NthObj);
+ gen_inlined_dec_funs(Fields,ClFields,ObjSName,Val,NthObj);
{CurrMod,Name} ->
- emit([" fun 'dec_",Name,"'/3"]),
+ emit(["'getdec_",ObjSName,"'(",{asis,Val},") ->",nl,
+ " fun 'dec_",Name,"'/3;", nl]),
NthObj;
{ModuleName,Name} ->
+ emit(["'getdec_",ObjSName,"'(",{asis,Val},") ->",nl]),
emit_ext_fun(dec,ModuleName,Name),
+ emit([";",nl]),
NthObj;
_ ->
- emit([" fun 'dec_",ObjName,"'/3"]),
+ emit(["'getdec_",ObjSName,"'(",{asis,Val},") ->",nl,
+ " fun 'dec_",ObjName,"'/3;", nl]),
NthObj
end,
- emit([";",nl]),
gen_objset_dec(Erules, ObjSName, UniqueName, T, ClName,
ClFields, NewNthObj);
gen_objset_dec(_,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName,
@@ -1394,10 +1413,15 @@ emit_default_getdec(ObjSetName,UniqueName) ->
emit(["'getdec_",ObjSetName,"'(ErrV) ->",nl]),
emit([indent(2), "fun(C,V,_) -> exit({{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},", ErrV}}) end"]).
-gen_inlined_dec_funs(Fields, ClFields, ObjSetName, NthObj) ->
+gen_inlined_dec_funs(Fields, [{typefield,_,_}|_]=ClFields, ObjSetName, Val, NthObj) ->
+ emit(["'getdec_",ObjSetName,"'(",{asis,Val},") ->",nl]),
emit([indent(3),"fun(Type, Bytes, _RestPrimFieldName) ->",nl,
indent(6),"case Type of",nl]),
- gen_inlined_dec_funs1(Fields, ClFields, ObjSetName, "", NthObj).
+ gen_inlined_dec_funs1(Fields, ClFields, ObjSetName, "", NthObj);
+gen_inlined_dec_funs(Fields, [_|ClFields], ObjSetName, Val, NthObj) ->
+ gen_inlined_dec_funs(Fields, ClFields, ObjSetName, Val, NthObj);
+gen_inlined_dec_funs(_, _, _, _,NthObj) ->
+ NthObj.
gen_inlined_dec_funs1(Fields, [{typefield,Name,Prop}|Rest],
ObjSetName, Sep0, NthObj) ->
@@ -1439,7 +1463,7 @@ gen_inlined_dec_funs1(Fields, [_|Rest], ObjSetName, Sep, NthObj)->
gen_inlined_dec_funs1(Fields, Rest, ObjSetName, Sep, NthObj);
gen_inlined_dec_funs1(_, [], _, _, NthObj) ->
emit([nl,indent(6),"end",nl,
- indent(3),"end"]),
+ indent(3),"end;",nl]),
NthObj.
emit_dec_open_type(I) ->
@@ -1534,39 +1558,6 @@ decode_class('CONTEXT') ->
decode_class('PRIVATE') ->
?PRIVATE.
-decode_type('BOOLEAN') -> 1;
-decode_type('INTEGER') -> 2;
-decode_type('BIT STRING') -> 3;
-decode_type('OCTET STRING') -> 4;
-decode_type('NULL') -> 5;
-decode_type('OBJECT IDENTIFIER') -> 6;
-decode_type('ObjectDescriptor') -> 7;
-decode_type('EXTERNAL') -> 8;
-decode_type('REAL') -> 9;
-decode_type('ENUMERATED') -> 10;
-decode_type('EMBEDDED_PDV') -> 11;
-decode_type('UTF8String') -> 12;
-decode_type('RELATIVE-OID') -> 13;
-decode_type('SEQUENCE') -> 16;
-decode_type('SEQUENCE OF') -> 16;
-decode_type('SET') -> 17;
-decode_type('SET OF') -> 17;
-decode_type('NumericString') -> 18;
-decode_type('PrintableString') -> 19;
-decode_type('TeletexString') -> 20;
-decode_type('T61String') -> 20;
-decode_type('VideotexString') -> 21;
-decode_type('IA5String') -> 22;
-decode_type('UTCTime') -> 23;
-decode_type('GeneralizedTime') -> 24;
-decode_type('GraphicString') -> 25;
-decode_type('VisibleString') -> 26;
-decode_type('GeneralString') -> 27;
-decode_type('UniversalString') -> 28;
-decode_type('BMPString') -> 30;
-decode_type('CHOICE') -> 'CHOICE'; % choice gets the tag from the actual alternative
-decode_type(Else) -> exit({error,{asn1,{unrecognized_type,Else}}}).
-
mkfuncname(#'Externaltypereference'{module=Mod,type=EType}, DecOrEnc) ->
CurrMod = get(currmod),
case CurrMod of
diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl
index bdd14871d1..91820e08de 100644
--- a/lib/asn1/src/asn1ct_imm.erl
+++ b/lib/asn1/src/asn1ct_imm.erl
@@ -499,6 +499,8 @@ per_dec_enumerated_fix_list([], Tail, _) -> Tail.
per_dec_integer_1([{'SingleValue',Value}], _Aligned) ->
{value,Value};
+per_dec_integer_1([{'ValueRange',{'MIN',_}}], Aligned) ->
+ per_dec_unconstrained(Aligned);
per_dec_integer_1([{'ValueRange',{Lb,'MAX'}}], Aligned) when is_integer(Lb) ->
per_decode_semi_constrained(Lb, Aligned);
per_dec_integer_1([{'ValueRange',{Lb,Ub}}], Aligned) when is_integer(Lb),
@@ -1094,6 +1096,9 @@ per_enc_integer_1(Val0, [Constr], Aligned) ->
per_enc_integer_2(Val, {'SingleValue',Sv}, Aligned) when is_integer(Sv) ->
per_enc_constrained(Val, Sv, Sv, Aligned);
+per_enc_integer_2(Val, {'ValueRange',{'MIN',Ub}}, Aligned)
+ when is_integer(Ub) ->
+ {[],{lt,Val,Ub+1},per_enc_unconstrained(Val, Aligned)};
per_enc_integer_2(Val0, {'ValueRange',{Lb,'MAX'}}, Aligned)
when is_integer(Lb) ->
{Prefix,Val} = sub_lb(Val0, Lb),
@@ -1580,7 +1585,7 @@ do_combine_put_bits(_, _, _) ->
throw(impossible).
debit(Budget0, Alternatives) ->
- case Budget0 - log2(Alternatives) of
+ case Budget0 - math:log2(Alternatives) of
Budget when Budget > 0.0 ->
Budget;
_ ->
@@ -1593,8 +1598,6 @@ num_clauses([_|T], N) ->
num_clauses(T, N+1);
num_clauses([], N) -> N.
-log2(N) ->
- math:log(N) / math:log(2.0).
collect_put_bits(Imm) ->
lists:splitwith(fun({put_bits,V,_,_}) when is_integer(V) -> true;
diff --git a/lib/asn1/src/asn1ct_parser.yrl b/lib/asn1/src/asn1ct_parser.yrl
deleted file mode 100644
index 083162f191..0000000000
--- a/lib/asn1/src/asn1ct_parser.yrl
+++ /dev/null
@@ -1,1177 +0,0 @@
-%%<copyright>
-%% <year>1997-2008</year>
-%% <holder>Ericsson AB, All Rights Reserved</holder>
-%%</copyright>
-%%<legalnotice>
-%% The contents of this file are subject to the Erlang Public License,
-%% Version 1.1, (the "License"); you may not use this file except in
-%% compliance with the License. You should have received a copy of the
-%% Erlang Public License along with this software. If not, it can be
-%% retrieved online at http://www.erlang.org/.
-%%
-%% Software distributed under the License is distributed on an "AS IS"
-%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
-%% the License for the specific language governing rights and limitations
-%% under the License.
-%%
-%% The Initial Developer of the Original Code is Ericsson AB.
-%%</legalnotice>
-%%
-Nonterminals
-ModuleDefinition ModuleIdentifier DefinitiveIdentifier DefinitiveObjIdComponentList
-DefinitiveObjIdComponent TagDefault ExtensionDefault
-ModuleBody Exports SymbolsExported Imports SymbolsImported
-SymbolsFromModuleList SymbolsFromModule GlobalModuleReference AssignedIdentifier SymbolList
-Symbol Reference AssignmentList Assignment
-ExtensionAndException
-ComponentTypeLists
-Externaltypereference Externalvaluereference DefinedType DefinedValue
-AbsoluteReference ItemSpec ItemId ComponentId TypeAssignment
-ValueAssignment
-% ValueSetTypeAssignment
-ValueSet
-Type BuiltinType NamedType ReferencedType
-Value ValueNotNull BuiltinValue ReferencedValue NamedValue
-% BooleanType
-BooleanValue IntegerType NamedNumberList NamedNumber SignedNumber
-% inlined IntegerValue
-EnumeratedType
-% inlined Enumerations
-Enumeration EnumerationItem
-% inlined EnumeratedValue
-% RealType
-RealValue NumericRealValue SpecialRealValue BitStringType
-% inlined BitStringValue
-IdentifierList
-% OctetStringType
-% inlined OctetStringValue
-% NullType NullValue
-SequenceType ComponentTypeList ComponentType
-% SequenceValue SequenceOfValue
-ComponentValueList SequenceOfType
-SAndSOfValue ValueList SetType
-% SetValue SetOfValue
-SetOfType
-ChoiceType
-% AlternativeTypeList made common with ComponentTypeList
-ChoiceValue
-AnyValue
-AnyDefBy
-SelectionType
-TaggedType Tag ClassNumber Class
-% redundant TaggedValue
-% EmbeddedPDVType EmbeddedPDVValue ExternalType ExternalValue ObjectIdentifierType
-ObjectIdentifierValue ObjIdComponentList ObjIdComponent
-% NameForm NumberForm NameAndNumberForm
-CharacterStringType
-RestrictedCharacterStringValue CharacterStringList
-% CharSyms CharsDefn
-Quadruple
-% Group Plane Row Cell
-Tuple
-% TableColumn TableRow
-% UnrestrictedCharacterString
-CharacterStringValue
-% UnrestrictedCharacterStringValue
-ConstrainedType Constraint ConstraintSpec TypeWithConstraint
-ElementSetSpecs ElementSetSpec
-%GeneralConstraint
-UserDefinedConstraint UserDefinedConstraintParameter
-UserDefinedConstraintParameters
-ExceptionSpec
-ExceptionIdentification
-Unions
-UnionMark
-UElems
-Intersections
-IntersectionElements
-IntersectionMark
-IElems
-Elements
-Elems
-SubTypeElements
-Exclusions
-LowerEndpoint
-UpperEndpoint
-LowerEndValue
-UpperEndValue
-TypeConstraints NamedConstraint PresenceConstraint
-
-ParameterizedTypeAssignment
-ParameterList
-Parameters
-Parameter
-ParameterizedType
-
-% X.681
-ObjectClassAssignment ObjectClass ObjectClassDefn
-FieldSpecs FieldSpec OptionalitySpec WithSyntaxSpec
-TokenOrGroupSpecs TokenOrGroupSpec
-SyntaxList OptionalGroup RequiredToken Word
-TypeOptionalitySpec
-ValueOrObjectOptSpec
-VSetOrOSetOptSpec
-ValueOptionalitySpec
-ObjectOptionalitySpec
-ValueSetOptionalitySpec
-ObjectSetOptionalitySpec
-% X.681 chapter 15
-InformationFromObjects
-ValueFromObject
-%ValueSetFromObjects
-TypeFromObject
-%ObjectFromObject
-%ObjectSetFromObjects
-ReferencedObjects
-FieldName
-PrimitiveFieldName
-
-ObjectAssignment
-ObjectSetAssignment
-ObjectSet
-ObjectSetElements
-Object
-ObjectDefn
-DefaultSyntax
-DefinedSyntax
-FieldSettings
-FieldSetting
-DefinedSyntaxTokens
-DefinedSyntaxToken
-Setting
-DefinedObject
-ObjectFromObject
-ObjectSetFromObjects
-ParameterizedObject
-ExternalObjectReference
-DefinedObjectSet
-DefinedObjectClass
-ExternalObjectClassReference
-
-% X.682
-TableConstraint
-ComponentRelationConstraint
-ComponentIdList
-
-% X.683
-ActualParameter
-.
-
-%UsefulType.
-
-Terminals
-'ABSENT' 'ABSTRACT-SYNTAX' 'ALL' 'ANY'
-'APPLICATION' 'AUTOMATIC' 'BEGIN' 'BIT'
-'BOOLEAN' 'BY' 'CHARACTER' 'CHOICE' 'CLASS' 'COMPONENT'
-'COMPONENTS' 'CONSTRAINED' 'DEFAULT' 'DEFINED' 'DEFINITIONS'
-'EMBEDDED' 'END' 'ENUMERATED' 'EXCEPT' 'EXPLICIT'
-'EXPORTS' 'EXTENSIBILITY' 'EXTERNAL' 'FALSE' 'FROM' 'GeneralizedTime'
-'TYPE-IDENTIFIER'
-'IDENTIFIER' 'IMPLICIT' 'IMPLIED' 'IMPORTS'
-'INCLUDES' 'INSTANCE' 'INTEGER' 'INTERSECTION'
-'MAX' 'MIN' 'MINUS-INFINITY' 'NULL'
-'OBJECT' 'ObjectDescriptor' 'OCTET' 'OF' 'OPTIONAL' 'PDV' 'PLUS-INFINITY'
-'PRESENT' 'PRIVATE' 'REAL' 'SEQUENCE' 'SET' 'SIZE'
-'STRING' 'SYNTAX' 'TAGS' 'TRUE' 'UNION'
-'UNIQUE' 'UNIVERSAL' 'UTCTime' 'WITH'
-'{' '}' '(' ')' '.' '::=' ';' ',' '@' '*' '-' '[' ']'
-'!' '..' '...' '|' '<' ':' '^'
-number identifier typereference restrictedcharacterstringtype
-bstring hstring cstring typefieldreference valuefieldreference
-objectclassreference word.
-
-Rootsymbol ModuleDefinition.
-Endsymbol '$end'.
-
-Left 300 'EXCEPT'.
-Left 200 '^'.
-Left 200 'INTERSECTION'.
-Left 100 '|'.
-Left 100 'UNION'.
-
-
-ModuleDefinition -> ModuleIdentifier
- 'DEFINITIONS'
- TagDefault
- ExtensionDefault
- '::='
- 'BEGIN'
- ModuleBody
- 'END' :
- {'ModuleBody',Ex,Im,Types} = '$7',
- {{typereference,Pos,Name},Defid} = '$1',
- #module{
- pos= Pos,
- name= Name,
- defid= Defid,
- tagdefault='$3',
- extensiondefault='$4',
- exports=Ex,
- imports=Im,
- typeorval=Types}.
-% {module, '$1','$3','$6'}.
-% Results always in a record of type module defined in asn_records.hlr
-
-ModuleIdentifier -> typereference DefinitiveIdentifier :
- put(asn1_module,'$1'#typereference.val),
- {'$1','$2'}.
-
-DefinitiveIdentifier -> '{' DefinitiveObjIdComponentList '}' : '$2' .
-DefinitiveIdentifier -> '$empty': [].
-
-DefinitiveObjIdComponentList -> DefinitiveObjIdComponent : ['$1'].
-DefinitiveObjIdComponentList -> DefinitiveObjIdComponent DefinitiveObjIdComponentList : ['$1'|'$2'].
-
-DefinitiveObjIdComponent -> identifier : '$1' . %expanded->
-% DefinitiveObjIdComponent -> NameForm : '$1' .
-DefinitiveObjIdComponent -> number : '$1' . %expanded->
-% DefinitiveObjIdComponent -> DefinitiveNumberForm : 'fix' .
-DefinitiveObjIdComponent -> identifier '(' number ')' : {'$1','$3'} . %expanded->
-% DefinitiveObjIdComponent -> DefinitiveNameAndNumberForm : {'$1','$3'} .
-
-% DefinitiveNumberForm -> number : 'fix' .
-
-% DefinitiveNameAndNumberForm -> identifier '(' DefinitiveNumberForm ')' : 'fix' .
-
-TagDefault -> 'EXPLICIT' 'TAGS' : put(tagdefault,'EXPLICIT'),'EXPLICIT' .
-TagDefault -> 'IMPLICIT' 'TAGS' : put(tagdefault,'IMPLICIT'),'IMPLICIT' .
-TagDefault -> 'AUTOMATIC' 'TAGS' : put(tagdefault,'AUTOMATIC'),'AUTOMATIC' .
-TagDefault -> '$empty': put(tagdefault,'EXPLICIT'),'EXPLICIT'. % because this is the default
-
-ExtensionDefault -> 'EXTENSIBILITY' 'IMPLIED' : 'IMPLIED'.
-ExtensionDefault -> '$empty' : 'false'. % because this is the default
-
-ModuleBody -> Exports Imports AssignmentList : {'ModuleBody','$1','$2','$3'}.
-ModuleBody -> '$empty' : {'ModuleBody',nil,nil,[]}.
-
-Exports -> 'EXPORTS' SymbolList ';' : {exports,'$2'}.
-Exports -> 'EXPORTS' ';' : {exports,[]}.
-Exports -> '$empty' : {exports,all} .
-
-% inlined above SymbolsExported -> SymbolList : '$1'.
-% inlined above SymbolsExported -> '$empty' : [].
-
-Imports -> 'IMPORTS' SymbolsFromModuleList ';' : {imports,'$2'}.
-Imports -> 'IMPORTS' ';' : {imports,[]}.
-Imports -> '$empty' : {imports,[]} .
-
-% inlined above SymbolsImported -> SymbolsFromModuleList : '$1'.
-% inlined above SymbolsImported -> '$empty' : [].
-
-SymbolsFromModuleList -> SymbolsFromModule :['$1'].
-% SymbolsFromModuleList -> SymbolsFromModuleList SymbolsFromModule :$1.%changed
-SymbolsFromModuleList -> SymbolsFromModule SymbolsFromModuleList :['$1'|'$2'].
-
-% expanded SymbolsFromModule -> SymbolList 'FROM' GlobalModuleReference : #'SymbolsFromModule'{symbols = '$1',module='$3'}.
-SymbolsFromModule -> SymbolList 'FROM' typereference : #'SymbolsFromModule'{symbols = '$1',module='$3'}.
-SymbolsFromModule -> SymbolList 'FROM' typereference '{' ValueList '}': #'SymbolsFromModule'{symbols = '$1',module='$3'}.
-%SymbolsFromModule -> SymbolList 'FROM' typereference identifier: #'SymbolsFromModule'{symbols = '$1',module='$3'}.
-%SymbolsFromModule -> SymbolList 'FROM' typereference Externalvaluereference: #'SymbolsFromModule'{symbols = '$1',module='$3'}.
-%SymbolsFromModule -> SymbolList 'FROM' typereference DefinedValue: #'SymbolsFromModule'{symbols = '$1',module='$3'}.
-
-% inlined GlobalModuleReference -> typereference AssignedIdentifier : {'$1','$2'} .
-
-% inlined above AssignedIdentifier -> '{' ValueList '}' : '$2'.
-% replaced AssignedIdentifier -> '{' DefinedValue ObjIdComponentList '}' :{'$2','$3'}.
-% not necessary , replaced by SAndSOfValue AssignedIdentifier -> ObjectIdentifierValue :'$1'.
-% AssignedIdentifier -> DefinedValue : '$1'.
-% inlined AssignedIdentifier -> '$empty' : undefined.
-
-SymbolList -> Symbol : ['$1'].
-SymbolList -> Symbol ',' SymbolList :['$1'|'$3'].
-
-Symbol -> Reference :'$1'.
-% later Symbol -> ParameterizedReference :'$1'.
-
-Reference -> typereference :'$1'.
-Reference -> identifier:'$1'.
-Reference -> typereference '{' '}':'$1'.
-Reference -> Externaltypereference '{' '}':'$1'.
-
-% later Reference -> objectclassreference :'$1'.
-% later Reference -> objectreference :'$1'.
-% later Reference -> objectsetreference :'$1'.
-
-AssignmentList -> Assignment : ['$1'].
-% modified AssignmentList -> AssignmentList Assignment : '$1'.
-AssignmentList -> Assignment AssignmentList : ['$1'|'$2'].
-
-Assignment -> TypeAssignment : '$1'.
-Assignment -> ValueAssignment : '$1'.
-% later Assignment -> ValueSetTypeAssignment : '$1'.
-Assignment -> ObjectClassAssignment : '$1'.
-% later Assignment -> ObjectAssignment : '$1'.
-% combined with ValueAssignment Assignment -> ObjectAssignment : '$1'.
-Assignment -> ObjectSetAssignment : '$1'.
-Assignment -> ParameterizedTypeAssignment : '$1'.
-%Assignment -> ParameterizedValueAssignment : '$1'.
-%Assignment -> ParameterizedValueSetTypeAssignment : '$1'.
-%Assignment -> ParameterizedObjectClassAssignment : '$1'.
-
-ObjectClassAssignment -> typereference '::=' 'CLASS' '{' FieldSpecs '}' :
-%ObjectClassAssignment -> objectclassreference '::=' 'CLASS' '{' FieldSpecs '}' :
- #typedef{pos=element(2,'$1'),name=element(3,'$1'),typespec={'CLASS','$5',[]}}.
-ObjectClassAssignment -> typereference '::=' 'CLASS' '{' FieldSpecs '}' WithSyntaxSpec :
-%ObjectClassAssignment -> objectclassreference '::=' 'CLASS' '{' FieldSpecs '}' WithSyntaxSpec :
- #typedef{pos=element(2,'$1'),name=element(3,'$1'),typespec={'CLASS','$5','$7'}}.
-
-FieldSpecs -> FieldSpec : ['$1'].
-FieldSpecs -> FieldSpec ',' FieldSpecs : ['$1'|'$3'].
-
-FieldSpec -> typefieldreference TypeOptionalitySpec : {typefield,'$1','$2'}.
-
-FieldSpec -> valuefieldreference Type 'UNIQUE' ValueOrObjectOptSpec :
- {fixedtypevaluefield,'$1','$2','UNIQUE','$4'}.
-FieldSpec -> valuefieldreference Type ValueOrObjectOptSpec :
- {fixedtypevaluefield,'$1','$2',undefined,'$3'}.
-
-FieldSpec -> valuefieldreference typefieldreference ValueOrObjectOptSpec :
- {variabletypevaluefield, '$1','$2','$3'}.
-
-FieldSpec -> typefieldreference typefieldreference VSetOrOSetOptSpec :
- {variabletypevaluesetfield, '$1','$2','$3'}.
-
-FieldSpec -> typefieldreference Type VSetOrOSetOptSpec :
- {fixedtypevaluesetfield, '$1','$2','$3'}.
-
-TypeOptionalitySpec -> 'DEFAULT' Type : {'DEFAULT','$2'}.
-TypeOptionalitySpec -> 'OPTIONAL' : 'OPTIONAL'.
-TypeOptionalitySpec -> '$empty' : 'MANDATORY'.
-
-ValueOrObjectOptSpec -> ValueOptionalitySpec : '$1'.
-ValueOrObjectOptSpec -> ObjectOptionalitySpec : '$1'.
-ValueOrObjectOptSpec -> 'OPTIONAL' : 'OPTIONAL'.
-ValueOrObjectOptSpec -> '$empty' : 'MANDATORY'.
-
-ValueOptionalitySpec -> 'DEFAULT' Value :
- case '$2' of
- {identifier,_,Id} -> {'DEFAULT',Id};
- _ -> {'DEFAULT','$2'}
- end.
-
-%ObjectOptionalitySpec -> 'DEFAULT' Object :{'DEFAULT','$1'}.
-ObjectOptionalitySpec -> 'DEFAULT' '{' FieldSetting ',' FieldSettings '}' :
- {'DEFAULT',{object,['$2'|'$4']}}.
-ObjectOptionalitySpec -> 'DEFAULT' '{' FieldSetting '}' :
- {'DEFAULT',{object, ['$2']}}.
-%ObjectOptionalitySpec -> 'DEFAULT' '{' DefinedSyntaxTokens '}' :
-% {'DEFAULT',{object, '$2'}}.
-ObjectOptionalitySpec -> 'DEFAULT' ObjectFromObject :
- {'DEFAULT',{object, '$2'}}.
-
-
-VSetOrOSetOptSpec -> ValueSetOptionalitySpec : '$1'.
-%VSetOrOSetOptSpec -> ObjectSetOptionalitySpec : '$1'.
-VSetOrOSetOptSpec -> 'OPTIONAL' : 'OPTIONAL'.
-VSetOrOSetOptSpec -> '$empty' : 'MANDATORY'.
-
-ValueSetOptionalitySpec -> 'DEFAULT' ValueSet : {'DEFAULT','$1'}.
-
-%ObjectSetOptionalitySpec -> 'DEFAULT' ObjectSet : {'DEFAULT','$1'}.
-
-OptionalitySpec -> 'DEFAULT' Type : {'DEFAULT','$2'}.
-OptionalitySpec -> 'DEFAULT' ValueNotNull :
- case '$2' of
- {identifier,_,Id} -> {'DEFAULT',Id};
- _ -> {'DEFAULT','$2'}
- end.
-OptionalitySpec -> 'OPTIONAL' : 'OPTIONAL'.
-OptionalitySpec -> '$empty' : 'MANDATORY'.
-
-WithSyntaxSpec -> 'WITH' 'SYNTAX' SyntaxList : {'WITH SYNTAX','$3'}.
-
-SyntaxList -> '{' TokenOrGroupSpecs '}' : '$2'.
-SyntaxList -> '{' '}' : [].
-
-TokenOrGroupSpecs -> TokenOrGroupSpec : ['$1'].
-TokenOrGroupSpecs -> TokenOrGroupSpec TokenOrGroupSpecs : ['$1'|'$2'].
-
-TokenOrGroupSpec -> RequiredToken : '$1'.
-TokenOrGroupSpec -> OptionalGroup : '$1'.
-
-OptionalGroup -> '[' TokenOrGroupSpecs ']' : '$2'.
-
-RequiredToken -> typereference : '$1'.
-RequiredToken -> Word : '$1'.
-RequiredToken -> ',' : '$1'.
-RequiredToken -> PrimitiveFieldName : '$1'.
-
-Word -> 'BY' : 'BY'.
-
-ParameterizedTypeAssignment -> typereference ParameterList '::=' Type :
- #ptypedef{pos=element(2,'$1'),name=element(3,'$1'),
- args='$2', typespec='$4'}.
-
-ParameterList -> '{' Parameters '}':'$2'.
-
-Parameters -> Parameter: ['$1'].
-Parameters -> Parameter ',' Parameters: ['$1'|'$3'].
-
-Parameter -> typereference: '$1'.
-Parameter -> Value: '$1'.
-Parameter -> Type ':' typereference: {'$1','$3'}.
-Parameter -> Type ':' Value: {'$1','$3'}.
-Parameter -> '{' typereference '}': {objectset,'$2'}.
-
-
-% Externaltypereference -> modulereference '.' typereference : {'$1','$3'} .
-Externaltypereference -> typereference '.' typereference : #'Externaltypereference'{pos=element(2,'$1'),module=element(3,'$1'),type=element(3,'$3')}.
-
-% Externalvaluereference -> modulereference '.' valuereference : {'$1','$3'} .
-% inlined Externalvaluereference -> typereference '.' identifier : #'Externalvaluereference'{pos=element(2,'$1'),module=element(3,'$1'),value=element(3,'$3')}.
-
-
-DefinedType -> Externaltypereference : '$1' .
-DefinedType -> typereference :
- #'Externaltypereference'{pos='$1'#typereference.pos,
- module= get(asn1_module),
- type= '$1'#typereference.val} .
-DefinedType -> typereference ParameterList : {pt,'$1','$2'}.
-DefinedType -> Externaltypereference ParameterList : {pt,'$1','$2'}.
-
-% ActualParameterList -> '{' ActualParameters '}' : '$1'.
-
-% ActualParameters -> ActualParameter : ['$1'].
-% ActualParameters -> ActualParameter ',' ActualParameters : ['$1'|'$3'].
-
-ActualParameter -> Type : '$1'.
-ActualParameter -> ValueNotNull : '$1'.
-ActualParameter -> ValueSet : '$1'.
-% later DefinedType -> ParameterizedType : '$1' .
-% later DefinedType -> ParameterizedValueSetType : '$1' .
-
-% inlined DefinedValue -> Externalvaluereference :'$1'.
-% inlined DefinedValue -> identifier :'$1'.
-% later DefinedValue -> ParameterizedValue :'$1'.
-
-% not referenced yet AbsoluteReference -> '@' GlobalModuleReference '.' ItemSpec :{'$2','$4'}.
-
-% not referenced yet ItemSpec -> typereference :'$1'.
-% not referenced yet ItemSpec -> ItemId '.' ComponentId : {'$1','$3'}.
-
-% not referenced yet ItemId -> ItemSpec : '$1'.
-
-% not referenced yet ComponentId -> identifier :'$1'.
-% not referenced yet ComponentId -> number :'$1'.
-% not referenced yet ComponentId -> '*' :'$1'.
-
-TypeAssignment -> typereference '::=' Type :
- #typedef{pos=element(2,'$1'),name=element(3,'$1'),typespec='$3'}.
-
-ValueAssignment -> identifier Type '::=' Value :
- #valuedef{pos=element(2,'$1'),name=element(3,'$1'),type='$2',value='$4'}.
-
-% later ValueSetTypeAssignment -> typereference Type '::=' ValueSet :{'ValueSetTypeAssignment','$1','$2','$4'}.
-
-
-ValueSet -> '{' ElementSetSpec '}' : {valueset,'$2'}.
-
-% record(type,{tag,def,constraint}).
-Type -> BuiltinType :#type{def='$1'}.
-Type -> 'NULL' :#type{def='NULL'}.
-Type -> TaggedType:'$1'.
-Type -> ReferencedType:#type{def='$1'}. % change notag later
-Type -> ConstrainedType:'$1'.
-
-%ANY is here for compatibility with the old ASN.1 standard from 1988
-BuiltinType -> 'ANY' AnyDefBy:
- case '$2' of
- [] -> 'ANY';
- _ -> {'ANY DEFINED BY','$2'}
- end.
-BuiltinType -> BitStringType :'$1'.
-BuiltinType -> 'BOOLEAN' :element(1,'$1').
-BuiltinType -> CharacterStringType :'$1'.
-BuiltinType -> ChoiceType :'$1'.
-BuiltinType -> 'EMBEDDED' 'PDV' :'EMBEDDED PDV'.
-BuiltinType -> EnumeratedType :'$1'.
-BuiltinType -> 'EXTERNAL' :element(1,'$1').
-% later BuiltinType -> InstanceOfType :'$1'.
-BuiltinType -> IntegerType :'$1'.
-% BuiltinType -> 'NULL' :element(1,'$1').
-% later BuiltinType -> ObjectClassFieldType :'$1'.
-BuiltinType -> 'OBJECT' 'IDENTIFIER' :'OBJECT IDENTIFIER'.
-BuiltinType -> 'OCTET' 'STRING' :'OCTET STRING'.
-BuiltinType -> 'REAL' :element(1,'$1').
-BuiltinType -> SequenceType :'$1'.
-BuiltinType -> SequenceOfType :'$1'.
-BuiltinType -> SetType :'$1'.
-BuiltinType -> SetOfType :'$1'.
-% The so called Useful types
-BuiltinType -> 'GeneralizedTime': 'GeneralizedTime'.
-BuiltinType -> 'UTCTime' :'UTCTime'.
-BuiltinType -> 'ObjectDescriptor' : 'ObjectDescriptor'.
-
-% moved BuiltinType -> TaggedType :'$1'.
-
-
-AnyDefBy -> 'DEFINED' 'BY' identifier: '$3'.
-AnyDefBy -> '$empty': [].
-
-NamedType -> identifier Type :
-%{_,Pos,Val} = '$1',
-%{'NamedType',Pos,{Val,'$2'}}.
-V1 = '$1',
-{'NamedType',V1#identifier.pos,{V1#identifier.val,'$2'}}.
-NamedType -> SelectionType :'$1'.
-
-ReferencedType -> DefinedType : '$1'.
-% redundant ReferencedType -> UsefulType : 'fix'.
-ReferencedType -> SelectionType : '$1'.
-ReferencedType -> TypeFromObject : '$1'.
-% later ReferencedType -> ValueSetFromObjects : 'fix'.
-
-% to much conflicts Value -> AnyValue :'$1'.
-Value -> ValueNotNull : '$1'.
-Value -> 'NULL' :element(1,'$1').
-
-ValueNotNull -> BuiltinValue :'$1'.
-% inlined Value -> DefinedValue :'$1'. % DefinedValue , identifier
-% inlined Externalvaluereference -> Externalvaluereference :'$1'.
-ValueNotNull -> typereference '.' identifier :
- #'Externalvaluereference'{pos=element(2,'$1'),module=element(3,'$1'),
- value=element(3,'$3')}.
-ValueNotNull -> identifier :'$1'.
-
-
-%tmp Value -> NamedNumber: '$1'. % not a value but part of ObjIdC
-% redundant BuiltinValue -> BitStringValue :'$1'.
-BuiltinValue -> BooleanValue :'$1'.
-BuiltinValue -> CharacterStringValue :'$1'.
-BuiltinValue -> ChoiceValue :'$1'.
-% BuiltinValue -> EmbeddedPDVValue :'$1'. ==SequenceValue
-% BuiltinValue -> EnumeratedValue :'$1'. identifier
-% BuiltinValue -> ExternalValue :'$1'. ==SequenceValue
-% later BuiltinValue -> InstanceOfValue :'$1'.
-BuiltinValue -> SignedNumber :'$1'.
-% BuiltinValue -> 'NULL' :'$1'.
-% later BuiltinValue -> ObjectClassFieldValue :'$1'.
-% replaced by SAndSOfValue BuiltinValue -> ObjectIdentifierValue :'$1'.
-BuiltinValue -> bstring :element(3,'$1').
-BuiltinValue -> hstring :element(3,'$1').
-% conflict BuiltinValue -> RealValue :'$1'.
-BuiltinValue -> SAndSOfValue :'$1'.
-% replaced BuiltinValue -> SequenceOfValue :'$1'.
-% replaced BuiltinValue -> SequenceValue :'$1'.
-% replaced BuiltinValue -> SetValue :'$1'.
-% replaced BuiltinValue -> SetOfValue :'$1'.
-% conflict redundant BuiltinValue -> TaggedValue :'$1'.
-
-% inlined ReferencedValue -> DefinedValue:'$1'.
-% ReferencedValue -> Externalvaluereference:'$1'.
-% ReferencedValue -> identifier :'$1'.
-% later ReferencedValue -> ValueFromObject:'$1'.
-
-% inlined BooleanType -> BOOLEAN :'BOOLEAN'.
-
-% to much conflicts AnyValue -> Type ':' Value : {'ANYVALUE',{'$1','$3'}}.
-
-BooleanValue -> TRUE :true.
-BooleanValue -> FALSE :false.
-
-IntegerType -> 'INTEGER' : 'INTEGER'.
-IntegerType -> 'INTEGER' '{' NamedNumberList '}' : {'INTEGER','$3'}.
-
-NamedNumberList -> NamedNumber :['$1'].
-% modified NamedNumberList -> NamedNumberList ',' NamedNumber :'fix'.
-NamedNumberList -> NamedNumber ',' NamedNumberList :['$1'|'$3'].
-
-NamedNumber -> identifier '(' SignedNumber ')' : {'NamedNumber',element(3,'$1'),'$3'}.
-NamedNumber -> identifier '(' typereference '.' identifier ')' : {'NamedNumber',element(3,'$1'),{'ExternalValue',element(3,'$3'),element(3,'$5')}}.
-NamedNumber -> identifier '(' identifier ')' : {'NamedNumber',element(3,'$1'),element(3,'$3')}.
-
-%NamedValue -> identifier Value :
-% {'NamedValue',element(2,'$1'),element(3,'$1'),'$2'}.
-
-
-SignedNumber -> number : element(3,'$1').
-SignedNumber -> '-' number : - element(3,'$1').
-
-% inlined IntegerValue -> SignedNumber :'$1'.
-% conflict moved to Value IntegerValue -> identifier:'$1'.
-
-EnumeratedType -> ENUMERATED '{' Enumeration '}' :{'ENUMERATED','$3'}.
-
-% inlined Enumerations -> Enumeration :{'$1','false',[]}.
-% inlined Enumerations -> Enumeration ',' '...' : {'$1','true',[]}.
-% inlined Enumerations -> Enumeration ',' '...' ',' Enumeration : {'$1','true','$5'}.
-
-Enumeration -> EnumerationItem :['$1'].
-% modified Enumeration -> EnumerationItem ',' Enumeration :'fix'.
-Enumeration -> EnumerationItem ',' Enumeration :['$1'|'$3'].
-
-EnumerationItem -> identifier:element(3,'$1').
-EnumerationItem -> NamedNumber :'$1'.
-EnumerationItem -> '...' :'EXTENSIONMARK'.
-
-% conflict moved to Value EnumeratedValue -> identifier:'$1'.
-
-% inlined RealType -> REAL:'REAL'.
-
-RealValue -> NumericRealValue :'$1'.
-RealValue -> SpecialRealValue:'$1'.
-
-% ?? NumericRealValue -> number:'$1'. % number MUST BE '0'
-NumericRealValue -> SAndSOfValue : '$1'. % Value of the associated sequence type
-
-SpecialRealValue -> 'PLUS-INFINITY' :'$1'.
-SpecialRealValue -> 'MINUS-INFINITY' :'$1'.
-
-BitStringType -> 'BIT' 'STRING' :{'BIT STRING',[]}.
-BitStringType -> 'BIT' 'STRING' '{' NamedNumberList '}' :{'BIT STRING','$4'}.
-% NamedBitList replaced by NamedNumberList to reduce the grammar
-% Must check later that all "numbers" are positive
-
-% inlined BitStringValue -> bstring:'$1'.
-% inlined BitStringValue -> hstring:'$1'.
-% redundant use SequenceValue BitStringValue -> '{' IdentifierList '}' :$2.
-% redundant use SequenceValue BitStringValue -> '{' '}' :'fix'.
-
-IdentifierList -> identifier :[element(3,'$1')].
-% modified IdentifierList -> IdentifierList ',' identifier :'$1'.
-IdentifierList -> identifier ',' IdentifierList :[element(3,'$1')|'$3'].
-
-% inlined OctetStringType -> 'OCTET' 'STRING' :'OCTET STRING'.
-
-% inlined OctetStringValue -> bstring:'$1'.
-% inlined OctetStringValue -> hstring:'$1'.
-
-% inlined NullType -> 'NULL':'NULL'.
-
-% inlined NullValue -> NULL:'NULL'.
-
-% result is {'SEQUENCE',Optionals,Extensionmark,Componenttypelist}.
-SequenceType -> SEQUENCE '{' ComponentTypeList '}' :{'SEQUENCE','$3'}.
-% SequenceType -> SEQUENCE '{' ComponentTypeLists '}' :{'SEQUENCE','$3'}.
-% SequenceType -> SEQUENCE '{' ExtensionAndException '}' :{'SEQUENCE','$3'}.
-SequenceType -> SEQUENCE '{' '}' :{'SEQUENCE',[]}.
-
-% result is {RootComponentList,ExtensionAndException,AdditionalComponentTypeList}.
-%ComponentTypeLists -> ComponentTypeList ',' ExtensionAndException :{'$1','$3',[]}.
-%ComponentTypeLists -> ComponentTypeList :{'$1','false',[]}.
-%ComponentTypeLists -> ComponentTypeList ',' ExtensionAndException
-% ',' ComponentTypeList :{'$1','$3', '$5'}.
-%ComponentTypeLists -> ExtensionAndException ',' ComponentTypeList :{[],'$1','$3'}.
-
-ComponentTypeList -> ComponentType :['$1'].
-% modified below ComponentTypeList -> ComponentTypeList ',' ComponentType :'$1'.
-ComponentTypeList -> ComponentType ',' ComponentTypeList :['$1'|'$3'].
-
-% -record('ComponentType',{pos,name,type,attrib}).
-ComponentType -> '...' ExceptionSpec :{'EXTENSIONMARK',element(2,'$1'),'$2'}.
-ComponentType -> NamedType :
- {'NamedType',Pos,{Name,Type}} = '$1',
- #'ComponentType'{pos=Pos,name=Name,typespec=Type,prop=mandatory}.
-ComponentType -> NamedType 'OPTIONAL' :
- {'NamedType',Pos,{Name,Type}} = '$1',
- #'ComponentType'{pos=Pos,name=Name,typespec=Type,prop='OPTIONAL'}.
-ComponentType -> NamedType 'DEFAULT' Value:
- {'NamedType',Pos,{Name,Type}} = '$1',
- #'ComponentType'{pos=Pos,name=Name,typespec=Type,prop={'DEFAULT','$3'}}.
-ComponentType -> 'COMPONENTS' 'OF' Type :{'COMPONENTS OF','$3'}.
-
-% redundant ExtensionAndException -> '...' : extensionmark.
-% ExtensionAndException -> '...' ExceptionSpec : {extensionmark,'$2'}.
-
-% replaced SequenceValue -> '{' ComponentValueList '}':'$2'.
-% replaced SequenceValue -> '{' '}':[].
-
-ValueList -> Value :['$1'].
-ValueList -> NamedNumber :['$1'].
-% modified ValueList -> ValueList ',' Value :'$1'.
-ValueList -> Value ',' ValueList :['$1'|'$3'].
-ValueList -> Value ',' '...' :['$1' |[]].
-ValueList -> Value ValueList : ['$1',space|'$2'].
-ValueList -> NamedNumber ValueList: ['$1',space|'$2'].
-
-%ComponentValueList -> identifier ObjIdComponent:[{'NamedValue','$1','$2'}].
-%ComponentValueList -> NamedValue :['$1'].
-%ComponentValueList -> NamedValue ',' ComponentValueList:['$1'|'$3'].
-%ComponentValueList -> identifier ObjIdComponent ',' ComponentValueList :[{'NamedValue', '$1','$2'}|'$4'].
-
-SequenceOfType -> SEQUENCE OF Type : {'SEQUENCE OF','$3'}.
-
-% replaced SequenceOfValue with SAndSOfValue
-
-SAndSOfValue -> '{' ValueList '}' :'$2'.
-%SAndSOfValue -> '{' ComponentValueList '}' :'$2'.
-SAndSOfValue -> '{' '}' :[].
-
-% save for later SetType ->
-% result is {'SET',Optionals,Extensionmark,Componenttypelist}.
-SetType -> SET '{' ComponentTypeList '}' :{'SET','$3'}.
-% SetType -> SET '{' ExtensionAndException '}' :{'SET','$3'}.
-SetType -> SET '{' '}' :{'SET',[]}.
-
-% replaced SetValue with SAndSOfValue
-
-SetOfType -> SET OF Type : {'SET OF','$3'}.
-
-% replaced SetOfValue with SAndSOfValue
-
-ChoiceType -> 'CHOICE' '{' ComponentTypeList '}' :{'CHOICE','$3'}.
-% AlternativeTypeList is replaced by ComponentTypeList
-ChoiceValue -> identifier ':' Value : {'ChoiceValue',element(3,'$1'),'$3'}.
-% save for later SelectionType ->
-
-TaggedType -> Tag Type : '$2'#type{tag=['$1'#tag{type={default,get(tagdefault)}}]}.
-TaggedType -> Tag IMPLICIT Type :'$3'#type{tag=['$1'#tag{type='IMPLICIT'}]}.
-TaggedType -> Tag EXPLICIT Type :'$3'#type{tag=['$1'#tag{type='EXPLICIT'}]}.
-
-Tag -> '[' Class ClassNumber ']': #tag{class='$2',number='$3'}.
-Tag -> '[' Class typereference '.' identifier ']':
- #tag{class='$2',number=#'Externalvaluereference'{pos=element(2,'$3'),module=element(3,'$3'),
- value=element(3,'$5')}}.
-Tag -> '[' Class number ']': #tag{class='$2',number=element(3,'$3')}.
-Tag -> '[' Class identifier ']': #tag{class='$2',number=element(3,'$3')}.
-
-ClassNumber -> number :element(3,'$1').
-% inlined above ClassNumber -> typereference '.' identifier :{'Externalvaluereference',element(3,'$1'),element(3,'$3')}.
-ClassNumber -> identifier :element(3,'$1').
-
-Class -> 'UNIVERSAL' :element(1,'$1').
-Class -> 'APPLICATION' :element(1,'$1').
-Class -> 'PRIVATE' :element(1,'$1').
-Class -> '$empty' :'CONTEXT'.
-
-% conflict redundant TaggedValue -> Value:'$1'.
-
-% inlined EmbeddedPDVType -> 'EMBEDDED' 'PDV' :'EMBEDDED PDV'.
-
-% inlined EmbeddedPDVValue -> SequenceValue:'$1'.
-
-% inlined ExternalType -> 'EXTERNAL' :'EXTERNAL'.
-
-% inlined ExternalValue -> SequenceValue :'$1'.
-
-% inlined ObjectIdentifierType -> 'OBJECT' 'IDENTIFIER' :'OBJECT IDENTIFIER'.
-
-ObjectIdentifierValue -> '{' ObjIdComponentList '}' :'$2'.
-% inlined ObjectIdentifierValue -> SequenceAndSequenceOfValue :'$1'.
-% ObjectIdentifierValue -> '{' identifier ObjIdComponentList '}' :{'ObjectIdentifierValue','$2','$3'}.
-% ObjectIdentifierValue -> '{' typereference '.' identifier ObjIdComponentList '}' :{'ObjectIdentifierValue',{'$2','$4'},'$5'}.
-
-ObjIdComponentList -> Value:'$1'.
-ObjIdComponentList -> Value ObjIdComponentList :['$1'|'$2'].
-%ObjIdComponentList -> DefinedValue:'$1'.
-%ObjIdComponentList -> number:'$1'.
-%ObjIdComponentList -> DefinedValue ObjIdComponentList :['$1'|'$2'].
-%ObjIdComponentList -> number ObjIdComponentList :['$1'|'$2'].
-%ObjIdComponentList -> ObjIdComponent ObjIdComponentList :['$1'|'$2'].
-%ObjIdComponentList -> ObjIdComponent ObjIdComponentList :['$1'|'$2'].
-
-% redundant ObjIdComponent -> NameForm :'$1'. % expanded
-% replaced by 2 ObjIdComponent -> NumberForm :'$1'.
-% ObjIdComponent -> number :'$1'.
-% ObjIdComponent -> DefinedValue :'$1'. % means DefinedValue
-% ObjIdComponent -> NameAndNumberForm :'$1'.
-% ObjIdComponent -> NamedNumber :'$1'.
-% NamedBit replaced by NamedNumber to reduce grammar
-% must check later that "number" is positive
-
-% NameForm -> identifier:'$1'.
-
-% inlined NumberForm -> number :'$1'.
-% inlined NumberForm -> DefinedValue :'$1'.
-
-% replaced by NamedBit NameAndNumberForm -> identifier '(' NumberForm ')'.
-% NameAndNumberForm -> NamedBit:'$1'.
-
-
-CharacterStringType -> restrictedcharacterstringtype :element(3,'$1').
-CharacterStringType -> 'CHARACTER' 'STRING' :'CHARACTER STRING'.
-
-RestrictedCharacterStringValue -> cstring :element(3, '$1').
-% modified below RestrictedCharacterStringValue -> CharacterStringList :'$1'.
-% conflict vs BuiltinValue RestrictedCharacterStringValue -> SequenceAndSequenceOfValue :'$1'.
-RestrictedCharacterStringValue -> Quadruple :'$1'.
-RestrictedCharacterStringValue -> Tuple :'$1'.
-
-% redundant CharacterStringList -> '{' ValueList '}' :'$2'. % modified
-
-% redundant CharSyms -> CharsDefn :'$1'.
-% redundant CharSyms -> CharSyms ',' CharsDefn :['$1'|'$3'].
-
-% redundant CharsDefn -> cstring :'$1'.
-% temporary replaced see below CharsDefn -> DefinedValue :'$1'.
-% redundant CharsDefn -> Value :'$1'.
-
-Quadruple -> '{' number ',' number ',' number ',' number '}' :{'Quadruple','$2','$4','$6','$8'}.
-% {Group,Plane,Row,Cell}
-
-Tuple -> '{' number ',' number '}' :{'Tuple', '$2','$4'}.
-% {TableColumn,TableRow}
-
-% inlined UnrestrictedCharacterString -> 'CHARACTER' 'STRING' :'CHARACTER STRING'.
-
-CharacterStringValue -> RestrictedCharacterStringValue :'$1'.
-% conflict vs BuiltinValue CharacterStringValue -> SequenceValue :'$1'. % UnrestrictedCharacterStringValue
-
-% inlined UsefulType -> typereference :'$1'.
-
-SelectionType -> identifier '<' Type : {'SelectionType',element(3,'$1'),'$3'}.
-
-ConstrainedType -> Type Constraint :
- '$1'#type{constraint=merge_constraints(['$2'])}.
-ConstrainedType -> Type Constraint Constraint :
- '$1'#type{constraint=merge_constraints(['$2','$3'])}.
-ConstrainedType -> Type Constraint Constraint Constraint:
- '$1'#type{constraint=merge_constraints(['$2','$3','$4'])}.
-ConstrainedType -> Type Constraint Constraint Constraint Constraint:
- '$1'#type{constraint=merge_constraints(['$2','$3','$4','$5'])}.
-%ConstrainedType -> Type Constraint :'$1'#type{constraint='$2'}.
-%ConstrainedType -> Type Constraint :'$1'#type{constraint='$2'}.
-ConstrainedType -> TypeWithConstraint :'$1'.
-
-TypeWithConstraint -> 'SET' Constraint 'OF' Type :
- #type{def = {'SET OF','$4'},constraint=merge_constraints(['$2'])}.
-TypeWithConstraint -> 'SET' 'SIZE' Constraint 'OF' Type :
- #type{def = {'SET OF','$5'},constraint = merge_constraints([#constraint{c={'SizeConstraint','$3'#constraint.c}}])}.
-TypeWithConstraint -> 'SEQUENCE' Constraint 'OF' Type :
- #type{def = {'SEQUENCE OF','$4'},constraint =
- merge_constraints(['$2'])}.
-TypeWithConstraint -> 'SEQUENCE' 'SIZE' Constraint 'OF' Type :
- #type{def = {'SEQUENCE OF','$5'},constraint = merge_constraints([#constraint{c={'SizeConstraint','$3'#constraint.c}}])}.
-
-
-Constraint -> '(' ConstraintSpec ExceptionSpec ')' :
- #constraint{c='$2',e='$3'}.
-
-% inlined Constraint -> SubTypeConstraint :'$1'.
-ConstraintSpec -> ElementSetSpecs :'$1'.
-ConstraintSpec -> UserDefinedConstraint :'$1'.
-ConstraintSpec -> TableConstraint :'$1'.
-
-TableConstraint -> ComponentRelationConstraint : '$1'.
-TableConstraint -> ObjectSet : '$1'.
-%TableConstraint -> '{' typereference '}' :tableconstraint.
-
-ComponentRelationConstraint -> '{' typereference '}' '{' '@' ComponentIdList '}' : componentrelation.
-ComponentRelationConstraint -> '{' typereference '}' '{' '@' '.' ComponentIdList '}' : componentrelation.
-
-ComponentIdList -> identifier: ['$1'].
-ComponentIdList -> identifier '.' ComponentIdList: ['$1'| '$3'].
-
-
-% later ConstraintSpec -> GeneralConstraint :'$1'.
-
-% from X.682
-UserDefinedConstraint -> 'CONSTRAINED' 'BY' '{' '}' : {constrained_by,[]}.
-UserDefinedConstraint -> 'CONSTRAINED' 'BY'
- '{' UserDefinedConstraintParameters '}' : {constrained_by,'$4'}.
-
-UserDefinedConstraintParameters -> UserDefinedConstraintParameter : ['$1'].
-UserDefinedConstraintParameters ->
- UserDefinedConstraintParameter ','
- UserDefinedConstraintParameters: ['$1'|'$3'].
-
-UserDefinedConstraintParameter -> Type '.' ActualParameter : {'$1','$3'}.
-UserDefinedConstraintParameter -> ActualParameter : '$1'.
-
-
-
-ExceptionSpec -> '!' ExceptionIdentification : '$1'.
-ExceptionSpec -> '$empty' : undefined.
-
-ExceptionIdentification -> SignedNumber : '$1'.
-% inlined ExceptionIdentification -> DefinedValue : '$1'.
-ExceptionIdentification -> typereference '.' identifier :
- #'Externalvaluereference'{pos=element(2,'$1'),module=element(3,'$1'),
- value=element(3,'$1')}.
-ExceptionIdentification -> identifier :'$1'.
-ExceptionIdentification -> Type ':' Value : {'$1','$3'}.
-
-% inlined SubTypeConstraint -> ElementSetSpec
-
-ElementSetSpecs -> ElementSetSpec : '$1'.
-ElementSetSpecs -> ElementSetSpec ',' '...': {'$1',[]}.
-ElementSetSpecs -> '...' ',' ElementSetSpec : {[],'$3'}.
-ElementSetSpecs -> ElementSetSpec ',' '...' ',' ElementSetSpec : {'$1','$5'}.
-
-ElementSetSpec -> Unions : '$1'.
-ElementSetSpec -> 'ALL' Exclusions : {'ALL','$2'}.
-
-Unions -> Intersections : '$1'.
-Unions -> UElems UnionMark IntersectionElements :
- case {'$1','$3'} of
- {{'SingleValue',V1},{'SingleValue',V2}} ->
- {'SingleValue',ordsets:union(to_set(V1),to_set(V2))}
- end.
-
-UElems -> Unions :'$1'.
-
-Intersections -> IntersectionElements :'$1'.
-Intersections -> IElems IntersectionMark IntersectionElements :
- case {'$1','$3'} of
- {{'SingleValue',V1},{'SingleValue',V2}} ->
- {'SingleValue',ordsets:intersection(to_set(V1),to_set(V2))};
- {V1,V2} when list(V1) ->
- V1 ++ [V2];
- {V1,V2} ->
- [V1,V2]
- end.
-%Intersections -> IElems '^' IntersectionElements :{'INTERSECTION','$1','$3'}.
-%Intersections -> IElems 'INTERSECTION' IntersectionElements :{'INTERSECTION','$1','$3'}.
-
-IElems -> Intersections :'$1'.
-
-IntersectionElements -> Elements :'$1'.
-IntersectionElements -> Elems Exclusions :{'$1','$2'}.
-
-Elems -> Elements :'$1'.
-
-Exclusions -> 'EXCEPT' Elements :{'EXCEPT','$2'}.
-
-IntersectionMark -> 'INTERSECTION':'$1'.
-IntersectionMark -> '^':'$1'.
-UnionMark -> 'UNION':'$1'.
-UnionMark -> '|':'$1'.
-
-
-Elements -> SubTypeElements : '$1'.
-%Elements -> ObjectSetElements : '$1'.
-Elements -> '(' ElementSetSpec ')' : '$2'.
-Elements -> ReferencedType : '$1'.
-
-SubTypeElements -> ValueList : {'SingleValue','$1'}. % NOTE it must be a Value
-% The rule above modifyed only because of conflicts
-SubTypeElements -> 'INCLUDES' Type : {'ContainedSubType','$2'}.
-%not lalr1 if this is activated SubTypeElements -> Type : {'TypeConstraint','$1'}.
-SubTypeElements -> LowerEndpoint '..' UpperEndpoint : {'ValueRange',{'$1','$3'}}.
-SubTypeElements -> 'FROM' Constraint : {'PermittedAlphabet','$2'#constraint.c}.
-SubTypeElements -> 'SIZE' Constraint: {'SizeConstraint','$2'#constraint.c}.
-% later will introduce conflicts related to NULL SubTypeElements -> Type : {'TypeConstraint','$1'}.
-SubTypeElements -> 'WITH' 'COMPONENT' Constraint:{'WITH COMPONENT','$3'}.
-SubTypeElements -> 'WITH' 'COMPONENTS' '{' TypeConstraints '}':{'WITH COMPONENTS',{'FullSpecification','$4'}}.
-SubTypeElements -> 'WITH' 'COMPONENTS' '{' '...' ',' TypeConstraints '}' :{'WITH COMPONENTS',{'PartialSpecification','$3'}}.
-
-% inlined above InnerTypeConstraints ::=
-% inlined above SingleTypeConstraint::= Constraint
-% inlined above MultipleTypeConstraints ::= FullSpecification | PartialSpecification
-% inlined above FullSpecification ::= "{" TypeConstraints "}"
-% inlined above PartialSpecification ::= "{" "..." "," TypeConstraints "}"
-% TypeConstraints -> identifier : [{'NamedConstraint',element(3,'$1'),undefined,undefined}]. % is this really meaningful or allowed
-TypeConstraints -> NamedConstraint : ['$1'].
-TypeConstraints -> NamedConstraint ',' TypeConstraints : ['$1'|'$3'].
-TypeConstraints -> identifier : ['$1'].
-TypeConstraints -> identifier ',' TypeConstraints : ['$1'|'$3'].
-
-NamedConstraint -> identifier Constraint PresenceConstraint :{'NamedConstraint',element(3,'$1'),'$2','$3'}.
-NamedConstraint -> identifier Constraint :{'NamedConstraint',element(3,'$1'),'$2',undefined}.
-NamedConstraint -> identifier PresenceConstraint :{'NamedConstraint',element(3,'$1'),undefined,'$2'}.
-
-PresenceConstraint -> 'PRESENT' : 'PRESENT'.
-PresenceConstraint -> 'ABSENT' : 'ABSENT'.
-PresenceConstraint -> 'OPTIONAL' : 'OPTIONAL'.
-
-
-
-LowerEndpoint -> LowerEndValue :'$1'.
-%LowerEndpoint -> LowerEndValue '<':{gt,'$1'}.
-LowerEndpoint -> LowerEndValue '<':('$1'+1).
-
-UpperEndpoint -> UpperEndValue :'$1'.
-%UpperEndpoint -> '<' UpperEndValue :{lt,'$2'}.
-UpperEndpoint -> '<' UpperEndValue :('$2'-1).
-
-LowerEndValue -> Value :'$1'.
-LowerEndValue -> 'MIN' :'MIN'.
-
-UpperEndValue -> Value :'$1'.
-UpperEndValue -> 'MAX' :'MAX'.
-
-
-% X.681
-
-
-% X.681 chap 15
-
-%TypeFromObject -> ReferencedObjects '.' FieldName : {'$1','$3'}.
-TypeFromObject -> typereference '.' FieldName : {'$1','$3'}.
-
-ReferencedObjects -> typereference : '$1'.
-%ReferencedObjects -> ParameterizedObject
-%ReferencedObjects -> DefinedObjectSet
-%ReferencedObjects -> ParameterizedObjectSet
-
-FieldName -> typefieldreference : ['$1'].
-FieldName -> valuefieldreference : ['$1'].
-FieldName -> FieldName '.' FieldName : ['$1' | '$3'].
-
-PrimitiveFieldName -> typefieldreference : '$1'.
-PrimitiveFieldName -> valuefieldreference : '$1'.
-
-%ObjectSetAssignment -> typereference DefinedObjectClass '::=' ObjectSet: null.
-ObjectSetAssignment -> typereference typereference '::=' ObjectSet :
- #typedef{pos=element(2,'$1'),name=element(3,'$1'),typespec={'ObjectSet',element(3,'$2'), '$4'}}.
-ObjectSetAssignment -> typereference typereference '.' typereference '::=' ObjectSet.
-
-ObjectSet -> '{' ElementSetSpecs '}' : '$2'.
-ObjectSet -> '{' '...' '}' : ['EXTENSIONMARK'].
-
-%ObjectSetElements -> Object.
-% ObjectSetElements -> identifier : '$1'.
-%ObjectSetElements -> DefinedObjectSet.
-%ObjectSetElements -> ObjectSetFromObjects.
-%ObjectSetElements -> ParameterizedObjectSet.
-
-%ObjectAssignment -> identifier DefinedObjectClass '::=' Object.
-ObjectAssignment -> ValueAssignment.
-%ObjectAssignment -> identifier typereference '::=' Object.
-%ObjectAssignment -> identifier typereference '.' typereference '::=' Object.
-
-%Object -> DefinedObject: '$1'.
-%Object -> ExternalObjectReference: '$1'.%Object -> DefinedObject: '$1'.
-Object -> typereference '.' identifier: '$1'.%Object -> DefinedObject: '$1'.
-Object -> identifier: '$1'.%Object -> DefinedObject: '$1'.
-
-%Object -> ObjectDefn -> DefaultSyntax: '$1'.
-Object -> '{' FieldSetting ',' FieldSettings '}' : ['$2'|'$4'].
-Object -> '{' FieldSetting '}' :['$2'].
-
-%% For User-friendly notation
-%% Object -> ObjectDefn -> DefinedSyntax
-Object -> '{' '}'.
-Object -> '{' DefinedSyntaxTokens '}'.
-
-% later Object -> ParameterizedObject: '$1'. look in x.683
-
-%DefinedObject -> ExternalObjectReference: '$1'.
-%DefinedObject -> identifier: '$1'.
-
-DefinedObjectClass -> typereference.
-%DefinedObjectClass -> objectclassreference.
-DefinedObjectClass -> ExternalObjectClassReference.
-%DefinedObjectClass -> typereference '.' objectclassreference.
-%%DefinedObjectClass -> UsefulObjectClassReference.
-
-ExternalObjectReference -> typereference '.' identifier.
-ExternalObjectClassReference -> typereference '.' typereference.
-%%ExternalObjectClassReference -> typereference '.' objectclassreference.
-
-ObjectDefn -> DefaultSyntax: '$1'.
-%ObjectDefn -> DefinedSyntax: '$1'.
-
-ObjectFromObject -> ReferencedObjects '.' FieldName : {'ObjectFromObject','$1','$3'}.
-
-% later look in x.683 ParameterizedObject ->
-
-%DefaultSyntax -> '{' '}'.
-%DefaultSyntax -> '{' FieldSettings '}': '$2'.
-DefaultSyntax -> '{' FieldSetting ',' FieldSettings '}': '$2'.
-DefaultSyntax -> '{' FieldSetting '}': '$2'.
-
-FieldSetting -> PrimitiveFieldName Setting: {'$1','$2'}.
-
-FieldSettings -> FieldSetting ',' FieldSettings: ['$1'|'$3'].
-FieldSettings -> FieldSetting ',' FieldSettings: ['$1'|'$3'].
-FieldSettings -> FieldSetting: '$1'.
-
-%DefinedSyntax -> '{' '}'.
-DefinedSyntax -> '{' DefinedSyntaxTokens '}': '$2'.
-
-DefinedSyntaxTokens -> DefinedSyntaxToken: '$1'.
-DefinedSyntaxTokens -> DefinedSyntaxToken DefinedSyntaxTokens: ['$1'|'$2'].
-
-% expanded DefinedSyntaxToken -> Literal: '$1'.
-%DefinedSyntaxToken -> typereference: '$1'.
-DefinedSyntaxToken -> word: '$1'.
-DefinedSyntaxToken -> ',': '$1'.
-DefinedSyntaxToken -> Setting: '$1'.
-%DefinedSyntaxToken -> '$empty': nil .
-
-% Setting ::= Type|Value|ValueSet|Object|ObjectSet
-Setting -> Type: '$1'.
-%Setting -> Value: '$1'.
-%Setting -> ValueNotNull: '$1'.
-Setting -> BuiltinValue: '$1'.
-Setting -> ValueSet: '$1'.
-%Setting -> Object: '$1'.
-%Setting -> ExternalObjectReference.
-Setting -> typereference '.' identifier.
-Setting -> identifier.
-Setting -> ObjectDefn.
-
-Setting -> ObjectSet: '$1'.
-
-
-Erlang code.
-%%-author('[email protected]').
--copyright('Copyright (c) 1991-99 Ericsson Telecom AB').
--vsn('$Revision: /main/release/1 $').
--include("asn1_records.hrl").
-
-to_set(V) when list(V) ->
- ordsets:list_to_set(V);
-to_set(V) ->
- ordsets:list_to_set([V]).
-
-merge_constraints({Rlist,ExtList}) -> % extensionmarker in constraint
- {merge_constraints(Rlist,[],[]),
- merge_constraints(ExtList,[],[])};
-
-merge_constraints(Clist) ->
- merge_constraints(Clist, [], []).
-
-merge_constraints([Ch|Ct],Cacc, Eacc) ->
- NewEacc = case Ch#constraint.e of
- undefined -> Eacc;
- E -> [E|Eacc]
- end,
- merge_constraints(Ct,[fixup_constraint(Ch#constraint.c)|Cacc],NewEacc);
-
-merge_constraints([],Cacc,[]) ->
- lists:flatten(Cacc);
-merge_constraints([],Cacc,Eacc) ->
- lists:flatten(Cacc) ++ [{'Errors',Eacc}].
-
-fixup_constraint(C) ->
- case C of
- {'SingleValue',V} when list(V) ->
- [C,
- {'ValueRange',{lists:min(V),lists:max(V)}}];
- {'PermittedAlphabet',{'SingleValue',V}} when list(V) ->
- V2 = {'SingleValue',
- ordsets:list_to_set(lists:flatten(V))},
- {'PermittedAlphabet',V2};
- {'PermittedAlphabet',{'SingleValue',V}} ->
- V2 = {'SingleValue',[V]},
- {'PermittedAlphabet',V2};
- {'SizeConstraint',Sc} ->
- {'SizeConstraint',fixup_size_constraint(Sc)};
-
- List when list(List) ->
- [fixup_constraint(Xc)||Xc <- List];
- Other ->
- Other
- end.
-
-fixup_size_constraint({'ValueRange',{Lb,Ub}}) ->
- {Lb,Ub};
-fixup_size_constraint({{'ValueRange',R},[]}) ->
- {R,[]};
-fixup_size_constraint({[],{'ValueRange',R}}) ->
- {[],R};
-fixup_size_constraint({{'ValueRange',R1},{'ValueRange',R2}}) ->
- {R1,R2};
-fixup_size_constraint({'SingleValue',[Sv]}) ->
- fixup_size_constraint({'SingleValue',Sv});
-fixup_size_constraint({'SingleValue',L}) when list(L) ->
- ordsets:list_to_set(L);
-fixup_size_constraint({'SingleValue',L}) ->
- {L,L};
-fixup_size_constraint({C1,C2}) ->
- {fixup_size_constraint(C1), fixup_size_constraint(C2)}.
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/lib/asn1/src/asn1ct_parser2.erl b/lib/asn1/src/asn1ct_parser2.erl
index 3891fce8d3..488e4af4e0 100644
--- a/lib/asn1/src/asn1ct_parser2.erl
+++ b/lib/asn1/src/asn1ct_parser2.erl
@@ -20,7 +20,7 @@
%%
-module(asn1ct_parser2).
--export([parse/1]).
+-export([parse/2,format_error/1]).
-include("asn1_records.hrl").
%% Only used internally within this module.
@@ -28,26 +28,34 @@
-record(constraint, {c,e}).
-record(identifier, {pos,val}).
-%% parse all types in module
-parse(Tokens) ->
- case catch parse_ModuleDefinition(Tokens) of
- {'EXIT',Reason} ->
- {error,{{undefined,get(asn1_module),
- [internal,error,'when',parsing,module,definition,Reason]},
- hd(Tokens)}};
- {asn1_error,Reason} ->
- {error,{Reason,hd(Tokens)}};
- {ModuleDefinition,Rest1} ->
- {Types,Rest2} = parse_AssignmentList(Rest1),
- clean_process_dictionary(),
- case Rest2 of
- [{'END',_}|_Rest3] ->
- {ok,ModuleDefinition#module{typeorval = Types}};
- _ ->
- {error,{{get_line(hd(Rest2)),get(asn1_module),
- [got,get_token(hd(Rest2)),expected,'END']},
- hd(Rest2)}}
- end
+parse(File0, Tokens0) ->
+ try do_parse(Tokens0) of
+ {ok,#module{}}=Result ->
+ Result
+ catch
+ throw:{asn1_error,Fun} when is_function(Fun, 0) ->
+ handle_parse_error(File0, Fun());
+ throw:{asn1_error,{parse_error,Tokens}} ->
+ handle_parse_error(File0, Tokens)
+ after
+ clean_process_dictionary()
+ end.
+
+handle_parse_error(File0, [Token|_]) ->
+ File = filename:basename(File0),
+ Line = get_line(Token),
+ Error = {structured_error,{File,Line},?MODULE,
+ {syntax_error,get_token(Token)}},
+ {error,[Error]}.
+
+do_parse(Tokens0) ->
+ {ModuleDefinition,Tokens1} = parse_ModuleDefinition(Tokens0),
+ {Types,Tokens2} = parse_AssignmentList(Tokens1),
+ case Tokens2 of
+ [{'END',_}|_Rest3] ->
+ {ok,ModuleDefinition#module{typeorval=Types}};
+ _ ->
+ parse_error(Tokens2)
end.
clean_process_dictionary() ->
@@ -57,6 +65,11 @@ clean_process_dictionary() ->
_ = erase(extensiondefault),
ok.
+format_error({syntax_error,Token}) when is_atom(Token) ->
+ io_lib:format("syntax error before: '~s'", [Token]);
+format_error({syntax_error,Token}) ->
+ io_lib:format("syntax error before: '~p'", [Token]).
+
parse_ModuleDefinition([{typereference,L1,ModuleIdentifier}|Rest0]) ->
put(asn1_module,ModuleIdentifier),
{_DefinitiveIdentifier,Rest02} =
@@ -70,9 +83,7 @@ parse_ModuleDefinition([{typereference,L1,ModuleIdentifier}|Rest0]) ->
[{'DEFINITIONS',_}|Rest03] ->
Rest03;
_ ->
- throw({asn1_error,{get_line(hd(Rest02)),get(asn1_module),
- [got,get_token(hd(Rest02)),
- expected,'DEFINITIONS']}})
+ parse_error(Rest02)
end,
{TagDefault,Rest2} =
case Rest of
@@ -104,12 +115,11 @@ parse_ModuleDefinition([{typereference,L1,ModuleIdentifier}|Rest0]) ->
extensiondefault = ExtensionDefault,
exports = Exports,
imports = {imports, Imports}}, Rest6};
- _ -> throw({asn1_error,{get_line(hd(Rest3)),get(asn1_module),
- [got,get_token(hd(Rest3)),expected,"::= BEGIN"]}})
+ _ ->
+ parse_error(Rest3)
end;
parse_ModuleDefinition(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,typereference]}}).
+ parse_error(Tokens).
parse_Exports([{'EXPORTS',_L1},{';',_L2}|Rest]) ->
{{exports,[]},Rest};
@@ -122,8 +132,7 @@ parse_Exports([{'EXPORTS',_L1}|Rest]) ->
[{';',_}|Rest3] ->
{{exports,SymbolList},Rest3};
_ ->
- throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module),
- [got,get_token(hd(Rest2)),expected,';']}})
+ parse_error(Rest2)
end;
parse_Exports(Rest) ->
{{exports,all},Rest}.
@@ -137,29 +146,25 @@ parse_SymbolList(Tokens,Acc) ->
[{',',_L1}|Rest2] ->
parse_SymbolList(Rest2,[Symbol|Acc]);
Rest2 ->
- {lists:reverse([Symbol|Acc]),Rest2}
+ {lists:reverse(Acc, [Symbol]),Rest2}
end.
parse_Symbol(Tokens) ->
parse_Reference(Tokens).
parse_Reference([{typereference,L1,TrefName},{'{',_L2},{'}',_L3}|Rest]) ->
-% {Tref,Rest};
{tref2Exttref(L1,TrefName),Rest};
parse_Reference([Tref1 = {typereference,_,_},{'.',_},Tref2 = {typereference,_,_},
{'{',_L2},{'}',_L3}|Rest]) ->
-% {{Tref1,Tref2},Rest};
{{tref2Exttref(Tref1),tref2Exttref(Tref2)},Rest};
parse_Reference([Tref = {typereference,_L1,_TrefName}|Rest]) ->
{tref2Exttref(Tref),Rest};
-parse_Reference([Vref = {identifier,_L1,_VName},{'{',_L2},{'}',_L3}|Rest]) ->
+parse_Reference([#identifier{}=Vref,{'{',_L2},{'}',_L3}|Rest]) ->
{identifier2Extvalueref(Vref),Rest};
-parse_Reference([Vref = {identifier,_L1,_VName}|Rest]) ->
+parse_Reference([#identifier{}=Vref|Rest]) ->
{identifier2Extvalueref(Vref),Rest};
parse_Reference(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,
- [typereference,identifier]]}}).
+ parse_error(Tokens).
parse_Imports([{'IMPORTS',_L1},{';',_L2}|Rest]) ->
{{imports,[]},Rest};
@@ -168,9 +173,8 @@ parse_Imports([{'IMPORTS',_L1}|Rest]) ->
case Rest2 of
[{';',_L2}|Rest3] ->
{{imports,SymbolsFromModuleList},Rest3};
- Rest3 ->
- throw({asn1_error,{get_line(hd(Rest3)),get(asn1_module),
- [got,get_token(hd(Rest3)),expected,';']}})
+ _ ->
+ parse_error(Rest2)
end;
parse_Imports(Tokens) ->
{{imports,[]},Tokens}.
@@ -180,11 +184,12 @@ parse_SymbolsFromModuleList(Tokens) ->
parse_SymbolsFromModuleList(Tokens,Acc) ->
{SymbolsFromModule,Rest} = parse_SymbolsFromModule(Tokens),
- case (catch parse_SymbolsFromModule(Rest)) of
+ try parse_SymbolsFromModule(Rest) of
{Sl,_Rest2} when is_record(Sl,'SymbolsFromModule') ->
- parse_SymbolsFromModuleList(Rest,[SymbolsFromModule|Acc]);
- _ ->
- {lists:reverse([SymbolsFromModule|Acc]),Rest}
+ parse_SymbolsFromModuleList(Rest, [SymbolsFromModule|Acc])
+ catch
+ throw:{asn1_error,_} ->
+ {lists:reverse(Acc, [SymbolsFromModule]),Rest}
end.
parse_SymbolsFromModule(Tokens) ->
@@ -198,169 +203,154 @@ parse_SymbolsFromModule(Tokens) ->
end,
{SymbolList,Rest} = parse_SymbolList(Tokens),
case Rest of
- [{'FROM',_L1},Tref = {typereference,_,Name},Ref={identifier,_L2,_Id},C={',',_}|Rest2] ->
- NewSymbolList = lists:map(SetRefModuleName(Name),SymbolList),
+ [{'FROM',_L1},{typereference,_,Name}=Tref|
+ [#identifier{},{',',_}|_]=Rest2] ->
+ NewSymbolList = lists:map(SetRefModuleName(Name), SymbolList),
{#'SymbolsFromModule'{symbols=NewSymbolList,
- module=tref2Exttref(Tref)},[Ref,C|Rest2]};
+ module=tref2Exttref(Tref)},Rest2};
%% This a special case when there is only one Symbol imported
%% from the next module. No other way to distinguish Ref from
%% a part of the GlobalModuleReference of Name.
- [{'FROM',_L1},Tref = {typereference,_,Name},Ref = {identifier,_L2,_Id},From = {'FROM',_}|Rest2] ->
- NewSymbolList = lists:map(SetRefModuleName(Name),SymbolList),
+ [{'FROM',_L1},{typereference,_,Name}=Tref|
+ [#identifier{},{'FROM',_}|_]=Rest2] ->
+ NewSymbolList = lists:map(SetRefModuleName(Name), SymbolList),
{#'SymbolsFromModule'{symbols=NewSymbolList,
- module=tref2Exttref(Tref)},[Ref,From|Rest2]};
- [{'FROM',_L1},Tref = {typereference,_,Name},{identifier,_L2,_Id}|Rest2] ->
- NewSymbolList = lists:map(SetRefModuleName(Name),SymbolList),
+ module=tref2Exttref(Tref)},Rest2};
+ [{'FROM',_L1},{typereference,_,Name}=Tref,#identifier{}|Rest2] ->
+ NewSymbolList = lists:map(SetRefModuleName(Name), SymbolList),
{#'SymbolsFromModule'{symbols=NewSymbolList,
module=tref2Exttref(Tref)},Rest2};
- [{'FROM',_L1},Tref = {typereference,_,Name},Brace = {'{',_}|Rest2] ->
- {_ObjIdVal,Rest3} = parse_ObjectIdentifierValue([Brace|Rest2]), % value not used yet, fix me
- NewSymbolList = lists:map(SetRefModuleName(Name),SymbolList),
+ [{'FROM',_L1},{typereference,_,Name}=Tref|[{'{',_}|_]=Rest2] ->
+ {_ObjIdVal,Rest3} = parse_ObjectIdentifierValue(Rest2), % value not used yet, fix me
+ NewSymbolList = lists:map(SetRefModuleName(Name), SymbolList),
{#'SymbolsFromModule'{symbols=NewSymbolList,
module=tref2Exttref(Tref)},Rest3};
- [{'FROM',_L1},Tref = {typereference,_,Name}|Rest2] ->
- NewSymbolList = lists:map(SetRefModuleName(Name),SymbolList),
+ [{'FROM',_L1},{typereference,_,Name}=Tref|Rest2] ->
+ NewSymbolList = lists:map(SetRefModuleName(Name), SymbolList),
{#'SymbolsFromModule'{symbols=NewSymbolList,
module=tref2Exttref(Tref)},Rest2};
_ ->
- throw({asn1_error,{get_line(hd(Rest)),get(asn1_module),
- [got,get_token(hd(Rest)),expected,
- ['FROM typerefernece identifier ,',
- 'FROM typereference identifier',
- 'FROM typereference {',
- 'FROM typereference']]}})
+ parse_error(Rest)
end.
parse_ObjectIdentifierValue([{'{',_}|Rest]) ->
parse_ObjectIdentifierValue(Rest,[]).
-parse_ObjectIdentifierValue([{number,_,Num}|Rest],Acc) ->
+parse_ObjectIdentifierValue([{number,_,Num}|Rest], Acc) ->
parse_ObjectIdentifierValue(Rest,[Num|Acc]);
-parse_ObjectIdentifierValue([{identifier,_,Id},{'(',_}, {number,_,Num}, {')',_}|Rest],Acc) ->
+parse_ObjectIdentifierValue([#identifier{val=Id},{'(',_},{number,_,Num},{')',_}|Rest], Acc) ->
parse_ObjectIdentifierValue(Rest,[{'NamedNumber',Id,Num}|Acc]);
-parse_ObjectIdentifierValue([{identifier,_,Id},{'(',_}, {identifier,_,Id2}, {')',_}|Rest],Acc) ->
+parse_ObjectIdentifierValue([#identifier{val=Id},{'(',_},#identifier{val=Id2},{')',_}|Rest], Acc) ->
parse_ObjectIdentifierValue(Rest,[{'NamedNumber',Id,Id2}|Acc]);
-parse_ObjectIdentifierValue([{identifier,_,Id},{'(',_}, {typereference,_,Tref},{'.',_},{identifier,_,Id2}, {')',_}|Rest],Acc) ->
- parse_ObjectIdentifierValue(Rest,[{'NamedNumber',Id,{'ExternalValue',Tref,Id2}}|Acc]);
-parse_ObjectIdentifierValue([Id = {identifier,_,_}|Rest],Acc) ->
- parse_ObjectIdentifierValue(Rest,[identifier2Extvalueref(Id)|Acc]);
-parse_ObjectIdentifierValue([{'}',_}|Rest],Acc) ->
+parse_ObjectIdentifierValue([#identifier{val=Id},{'(',_},{typereference,_,Tref},{'.',_},#identifier{val=Id2}, {')',_}|Rest], Acc) ->
+ parse_ObjectIdentifierValue(Rest, [{'NamedNumber',Id,{'ExternalValue',Tref,Id2}}|Acc]);
+parse_ObjectIdentifierValue([#identifier{}=Id|Rest], Acc) ->
+ parse_ObjectIdentifierValue(Rest, [identifier2Extvalueref(Id)|Acc]);
+parse_ObjectIdentifierValue([{'}',_}|Rest], Acc) ->
{lists:reverse(Acc),Rest};
-parse_ObjectIdentifierValue([H|_T],_Acc) ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,
- ['{ some of the following }',number,'identifier ( number )',
- 'identifier ( identifier )',
- 'identifier ( typereference.identifier)',identifier]]}}).
+parse_ObjectIdentifierValue(Tokens, _Acc) ->
+ parse_error(Tokens).
-parse_AssignmentList(Tokens = [{'END',_}|_Rest]) ->
- {[],Tokens};
-parse_AssignmentList(Tokens = [{'$end',_}|_Rest]) ->
- {[],Tokens};
parse_AssignmentList(Tokens) ->
- parse_AssignmentList(Tokens,[]).
+ parse_AssignmentList(Tokens, []).
-parse_AssignmentList(Tokens= [{'END',_}|_Rest],Acc) ->
+parse_AssignmentList([{'END',_}|_]=Tokens, Acc) ->
{lists:reverse(Acc),Tokens};
-parse_AssignmentList(Tokens= [{'$end',_}|_Rest],Acc) ->
+parse_AssignmentList([{'$end',_}|_]=Tokens, Acc) ->
{lists:reverse(Acc),Tokens};
-parse_AssignmentList(Tokens,Acc) ->
- case (catch parse_Assignment(Tokens)) of
- {'EXIT',Reason} ->
- exit(Reason);
- {asn1_error,R} ->
-% [H|T] = Tokens,
- throw({error,{R,hd(Tokens)}});
- {Assignment,Rest} ->
- parse_AssignmentList(Rest,[Assignment|Acc])
- end.
-
-parse_Assignment(Tokens) ->
- Flist = [fun parse_TypeAssignment/1,
- fun parse_ValueAssignment/1,
- fun parse_ObjectClassAssignment/1,
- fun parse_ObjectAssignment/1,
- fun parse_ObjectSetAssignment/1,
- fun parse_ParameterizedAssignment/1,
+parse_AssignmentList(Tokens0, Acc) ->
+ {Assignment,Tokens} = parse_Assignment(Tokens0),
+ parse_AssignmentList(Tokens, [Assignment|Acc]).
+
+parse_Assignment([{typereference,L1,Name},{'::=',_}|Tokens0]) ->
+ %% 1) Type ::= TypeDefinition
+ %% 2) CLASS-NAME ::= CLASS {...}
+ Flist = [{type,fun parse_Type/1},
+ {class,fun parse_ObjectClass/1}],
+ case parse_or_tag(Tokens0, Flist) of
+ {{type,Type},Tokens} ->
+ %% TypeAssignment
+ {#typedef{pos=L1,name=Name,typespec=Type},Tokens};
+ {{class,Type},Tokens} ->
+ %% ObjectClassAssignment
+ {#classdef{pos=L1,name=Name,module=resolve_module(Type),
+ typespec=Type},Tokens}
+ end;
+parse_Assignment([{typereference,_,_},{'{',_}|_]=Tokens) ->
+ %% 1) Type{...} ::= ...
+ %% 2) ValueSet{...} Type ::= ...
+ %% ObjectSet{...} CLASS-NAME ::= CLASS {...}
+ %% 3) CLASS-NAME{...} ::= CLASS {...}
+ %% A parameterized value set and and a parameterized object set
+ %% cannot be distinguished from each other without type information.
+ Flist = [fun parse_ParameterizedTypeAssignment/1,
+ fun parse_ParameterizedValueSetTypeAssignment/1,
+ fun parse_ParameterizedObjectClassAssignment/1],
+ parse_or(Tokens, Flist);
+parse_Assignment([{typereference,_,_}|_]=Tokens) ->
+ %% 1) ObjectSet CLASS-NAME ::= ...
+ %% 2) ValueSet Type ::= ...
+ Flist = [fun parse_ObjectSetAssignment/1,
fun parse_ValueSetTypeAssignment/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_} ->
- throw(AsnErr);
- {asn1_assignment_error,Reason} ->
- throw({asn1_error,Reason});
- Result ->
- Result
- end.
-
+ parse_or(Tokens, Flist);
+parse_Assignment([#identifier{},{'{',_}|_]=Tokens) ->
+ %% 1) value{...} Type ::= ...
+ %% 2) object{...} CLASS-NAME ::= ...
+ Flist = [fun parse_ParameterizedValueAssignment/1,
+ fun parse_ParameterizedObjectAssignment/1],
+ parse_or(Tokens, Flist);
+parse_Assignment([#identifier{}|_]=Tokens) ->
+ %% 1) value Type ::= ...
+ %% 2) object CLASS-NAME ::= ...
+ Flist = [fun parse_ValueAssignment/1,
+ fun parse_ObjectAssignment/1],
+ parse_or(Tokens, Flist);
+parse_Assignment(Tokens) ->
+ parse_error(Tokens).
parse_or(Tokens,Flist) ->
parse_or(Tokens,Flist,[]).
-parse_or(_Tokens,[],ErrList) ->
- case ErrList of
- [] ->
- throw({asn1_error,{parse_or,ErrList}});
- L when is_list(L) ->
- %% chose to throw 1) the error with the highest line no,
- %% 2) the last error which is not a asn1_assignment_error or
- %% 3) the last error.
- throw(prioritize_error(ErrList))
+parse_or(Tokens, [Fun|Funs], ErrList) when is_function(Fun, 1) ->
+ try Fun(Tokens) of
+ {_,Rest}=Result when is_list(Rest) ->
+ Result
+ catch
+ throw:{asn1_error,Error} ->
+ parse_or(Tokens, Funs, [Error|ErrList])
end;
-parse_or(Tokens,[Fun|Frest],ErrList) ->
- case (catch Fun(Tokens)) of
- Exit = {'EXIT',_Reason} ->
- parse_or(Tokens,Frest,[Exit|ErrList]);
- AsnErr = {asn1_error,_} ->
- parse_or(Tokens,Frest,[AsnErr|ErrList]);
- AsnAssErr = {asn1_assignment_error,_} ->
- parse_or(Tokens,Frest,[AsnAssErr|ErrList]);
- Result = {_,L} when is_list(L) ->
- Result;
- Error ->
- parse_or(Tokens,Frest,[Error|ErrList])
- end.
-
-parse_or_tag(Tokens,Flist) ->
- parse_or_tag(Tokens,Flist,[]).
-
-parse_or_tag(_Tokens,[],ErrList) ->
- case ErrList of
- [] ->
- throw({asn1_error,{parse_or_tag,ErrList}});
- L when is_list(L) ->
- %% chose to throw 1) the error with the highest line no,
- %% 2) the last error which is not a asn1_assignment_error or
- %% 3) the last error.
- throw(prioritize_error(ErrList))
+parse_or(_Tokens, [], ErrList) ->
+ throw({asn1_error,fun() -> prioritize_error(ErrList) end}).
+
+parse_or_tag(Tokens, Flist) ->
+ parse_or_tag(Tokens, Flist, []).
+
+parse_or_tag(Tokens, [{Tag,Fun}|Funs], ErrList) when is_function(Fun, 1) ->
+ try Fun(Tokens) of
+ {Parsed,Rest} when is_list(Rest) ->
+ {{Tag,Parsed},Rest}
+ catch
+ throw:{asn1_error,Error} ->
+ parse_or_tag(Tokens, Funs, [Error|ErrList])
end;
-parse_or_tag(Tokens,[{Tag,Fun}|Frest],ErrList) when is_function(Fun) ->
- case (catch Fun(Tokens)) of
- Exit = {'EXIT',_Reason} ->
- parse_or_tag(Tokens,Frest,[Exit|ErrList]);
- AsnErr = {asn1_error,_} ->
- parse_or_tag(Tokens,Frest,[AsnErr|ErrList]);
- AsnAssErr = {asn1_assignment_error,_} ->
- parse_or_tag(Tokens,Frest,[AsnAssErr|ErrList]);
- {ParseRes,Rest} when is_list(Rest) ->
- {{Tag,ParseRes},Rest};
- Error ->
- parse_or_tag(Tokens,Frest,[Error|ErrList])
- end.
+parse_or_tag(_Tokens, [], ErrList) ->
+ throw({asn1_error,fun() -> prioritize_error(ErrList) end}).
+
+prioritize_error(Errors0) ->
+ Errors1 = prioritize_error_1(Errors0),
+ Errors2 = [{length(L),L} || L <- Errors1],
+ Errors = lists:sort(Errors2),
+ [Res|_] = [L || {_,L} <- Errors],
+ Res.
+
+prioritize_error_1([F|T]) when is_function(F, 0) ->
+ [F()|prioritize_error_1(T)];
+prioritize_error_1([{parse_error,Tokens}|T]) ->
+ [Tokens|prioritize_error_1(T)];
+prioritize_error_1([]) ->
+ [].
-parse_TypeAssignment([{typereference,L1,Tref},{'::=',_}|Rest]) ->
- {Type,Rest2} = parse_Type(Rest),
- {#typedef{pos=L1,name=Tref,typespec=Type},Rest2};
-parse_TypeAssignment([H1,H2|_Rest]) ->
- throw({asn1_assignment_error,{get_line(H1),get(asn1_module),
- [got,[get_token(H1),get_token(H2)], expected,
- typereference,'::=']}});
-parse_TypeAssignment([H|_T]) ->
- throw({asn1_assignment_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,
- typereference]}}).
%% parse_Type(Tokens) -> Ret
%%
@@ -370,9 +360,8 @@ parse_TypeAssignment([H|_T]) ->
%%
parse_Type(Tokens) ->
{Tag,Rest3} = case Tokens of
- [Lbr= {'[',_}|Rest] ->
- parse_Tag([Lbr|Rest]);
- Rest-> {[],Rest}
+ [{'[',_}|_] -> parse_Tag(Tokens);
+ _ -> {[],Tokens}
end,
{Tag2,Rest4} = case Rest3 of
[{'IMPLICIT',_}|Rest31] when is_record(Tag,tag)->
@@ -384,31 +373,17 @@ parse_Type(Tokens) ->
Rest31 ->
{Tag,Rest31}
end,
- Flist = [fun parse_BuiltinType/1,fun parse_ReferencedType/1,fun parse_TypeWithConstraint/1],
- {Type,Rest5} = case (catch parse_or(Rest4,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_Reason} ->
- throw(AsnErr);
- Result ->
- Result
- end,
- case hd(Rest5) of
- {'(',_} ->
+ Flist = [fun parse_BuiltinType/1,
+ fun parse_ReferencedType/1,
+ fun parse_TypeWithConstraint/1],
+ {Type,Rest5} = parse_or(Rest4, Flist),
+ case Rest5 of
+ [{'(',_}|_] ->
{Constraints,Rest6} = parse_Constraints(Rest5),
- if is_record(Type,type) ->
- {Type#type{constraint=merge_constraints(Constraints),
- tag=Tag2},Rest6};
- true ->
- {#type{def=Type,constraint=merge_constraints(Constraints),
- tag=Tag2},Rest6}
- end;
- _ ->
- if is_record(Type,type) ->
- {Type#type{tag=Tag2},Rest5};
- true ->
- {#type{def=Type,tag=Tag2},Rest5}
- end
+ {Type#type{tag=Tag2,
+ constraint=merge_constraints(Constraints)},Rest6};
+ [_|_] ->
+ {Type#type{tag=Tag2},Rest5}
end.
parse_BuiltinType([{'BIT',_},{'STRING',_}|Rest]) ->
@@ -419,11 +394,10 @@ parse_BuiltinType([{'BIT',_},{'STRING',_}|Rest]) ->
[{'}',_}|Rest4] ->
{#type{def={'BIT STRING',NamedNumberList}},Rest4};
_ ->
- throw({asn1_error,{get_line(hd(Rest3)),get(asn1_module),
- [got,get_token(hd(Rest3)),expected,'}']}})
+ parse_error(Rest3)
end;
_ ->
- {{'BIT STRING',[]},Rest}
+ {#type{def={'BIT STRING',[]}},Rest}
end;
parse_BuiltinType([{'BOOLEAN',_}|Rest]) ->
{#type{def='BOOLEAN'},Rest};
@@ -435,41 +409,33 @@ parse_BuiltinType([{'CHARACTER',_},{'STRING',_}|Rest]) ->
{#type{def='CHARACTER STRING'},Rest};
parse_BuiltinType([{'CHOICE',_},{'{',_}|Rest]) ->
- {AlternativeTypeLists,Rest2} = parse_AlternativeTypeLists(Rest),
- AlternativeTypeLists1 =
- lists:filter(fun(#'ExtensionAdditionGroup'{}) -> false;
- ('ExtensionAdditionGroupEnd') -> false;
- (_) -> true
- end,AlternativeTypeLists),
+ {L0,Rest2} = parse_AlternativeTypeLists(Rest),
case Rest2 of
[{'}',_}|Rest3] ->
- AlternativeTypeLists2 =
- case {[Ext||Ext = #'EXTENSIONMARK'{} <- AlternativeTypeLists1],
- get(extensiondefault)} of
- {[],'IMPLIED'} -> AlternativeTypeLists1 ++ [#'EXTENSIONMARK'{}];
- _ -> AlternativeTypeLists1
+ NeedExt = not lists:keymember('EXTENSIONMARK', 1, L0) andalso
+ get(extensiondefault) =:= 'IMPLIED',
+ L = case NeedExt of
+ true ->
+ L0 ++ [#'EXTENSIONMARK'{}];
+ false ->
+ L0
end,
-
- {#type{def={'CHOICE',AlternativeTypeLists2}},Rest3};
+ {#type{def={'CHOICE',L}},Rest3};
_ ->
- throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module),
- [got,get_token(hd(Rest2)),expected,'}']}})
+ parse_error(Rest2)
end;
parse_BuiltinType([{'EMBEDDED',_},{'PDV',_}|Rest]) ->
{#type{def='EMBEDDED PDV'},Rest};
parse_BuiltinType([{'ENUMERATED',_},{'{',_}|Rest]) ->
- {Enumerations,Rest2} = parse_Enumerations(Rest,get(extensiondefault)),
+ {Enumerations,Rest2} = parse_Enumerations(Rest),
case Rest2 of
[{'}',_}|Rest3] ->
{#type{def={'ENUMERATED',Enumerations}},Rest3};
_ ->
- throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module),
- [got,get_token(hd(Rest2)),expected,'}']}})
+ parse_error(Rest2)
end;
parse_BuiltinType([{'EXTERNAL',_}|Rest]) ->
{#type{def='EXTERNAL'},Rest};
-
-% InstanceOfType
parse_BuiltinType([{'INSTANCE',_},{'OF',_}|Rest]) ->
{DefinedObjectClass,Rest2} = parse_DefinedObjectClass(Rest),
case Rest2 of
@@ -480,9 +446,6 @@ parse_BuiltinType([{'INSTANCE',_},{'OF',_}|Rest]) ->
_ ->
{#type{def={'INSTANCE OF',DefinedObjectClass,[]}},Rest2}
end;
-
-% parse_BuiltinType(Tokens) ->
-
parse_BuiltinType([{'INTEGER',_}|Rest]) ->
case Rest of
[{'{',_}|Rest2] ->
@@ -491,17 +454,13 @@ parse_BuiltinType([{'INTEGER',_}|Rest]) ->
[{'}',_}|Rest4] ->
{#type{def={'INTEGER',NamedNumberList}},Rest4};
_ ->
- throw({asn1_error,{get_line(hd(Rest3)),get(asn1_module),
- [got,get_token(hd(Rest3)),expected,'}']}})
+ parse_error(Rest3)
end;
_ ->
{#type{def='INTEGER'},Rest}
end;
parse_BuiltinType([{'NULL',_}|Rest]) ->
{#type{def='NULL'},Rest};
-
-% ObjectClassFieldType fix me later
-
parse_BuiltinType([{'OBJECT',_},{'IDENTIFIER',_}|Rest]) ->
{#type{def='OBJECT IDENTIFIER'},Rest};
parse_BuiltinType([{'OCTET',_},{'STRING',_}|Rest]) ->
@@ -529,18 +488,14 @@ parse_BuiltinType([{'SEQUENCE',_},{'{',_},{'...',Line},{'!',_}|Rest]) ->
parse_ComponentTypeLists2(Rest2,[#'EXTENSIONMARK'{pos=Line}]),
case Rest3 of
[{'}',_}|Rest4] ->
- {#type{def=#'SEQUENCE'{components=ComponentTypeLists}},Rest4};
+ {#type{def=#'SEQUENCE'{components=ComponentTypeLists}},Rest4};
_ ->
- throw({asn1_error,{get_line(hd(Rest3)),get(asn1_module),
- [got,get_token(hd(Rest3)),expected,'}']}})
+ parse_error(Rest3)
end
-% _ -> % Seq case 4,17-19,23-26 will fail here
-% throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module),
-% [got,get_token(hd(Rest2)),expected,'}']}})
end;
parse_BuiltinType([{'SEQUENCE',_},{'{',_}|Rest]) ->
{ComponentTypeLists,Rest2} = parse_ComponentTypeLists(Rest),
- case Rest2 of
+ case Rest2 of
[{'}',_}|Rest3] ->
ComponentTypeLists2 =
case {[Ext||Ext = #'EXTENSIONMARK'{} <- ComponentTypeLists],
@@ -551,25 +506,19 @@ parse_BuiltinType([{'SEQUENCE',_},{'{',_}|Rest]) ->
{#type{def=#'SEQUENCE'{components = ComponentTypeLists2}},
Rest3};
_ ->
- throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module),
- [got,get_token(hd(Rest2)),expected,'}']}})
+ parse_error(Rest2)
end;
-
-parse_BuiltinType([{'SEQUENCE',_},{'OF',_},Id={identifier,_,_},Lt={'<',_}|Rest]) ->
-%% TODO: take care of the identifier for something useful
- {Type,Rest2} = parse_SelectionType([Id,Lt|Rest]),
- {#type{def={'SEQUENCE OF',#type{def=Type,tag=[]}}},Rest2};
-
-parse_BuiltinType([{'SEQUENCE',_},{'OF',_},{identifier,_,_} |Rest]) ->
+parse_BuiltinType([{'SEQUENCE',_},{'OF',_}|
+ [#identifier{},{'<',_}|_]=Tokens0]) ->
+ {Type,Tokens} = parse_SelectionType(Tokens0),
+ {#type{def={'SEQUENCE OF',Type}},Tokens};
+parse_BuiltinType([{'SEQUENCE',_},{'OF',_},#identifier{} |Rest]) ->
%% TODO: take care of the identifier for something useful
{Type,Rest2} = parse_Type(Rest),
{#type{def={'SEQUENCE OF',Type}},Rest2};
-
parse_BuiltinType([{'SEQUENCE',_},{'OF',_}|Rest]) ->
{Type,Rest2} = parse_Type(Rest),
{#type{def={'SEQUENCE OF',Type}},Rest2};
-
-
parse_BuiltinType([{'SET',_},{'{',_},{'...',Line},{'}',_}|Rest]) ->
{#type{def=#'SET'{components=[#'EXTENSIONMARK'{pos = Line}]}},Rest};
parse_BuiltinType([{'SET',_},{'{',_},{'...',Line},{'!',_}|Rest]) ->
@@ -581,12 +530,18 @@ parse_BuiltinType([{'SET',_},{'{',_},{'...',Line},{'!',_}|Rest]) ->
val = ExceptionIdentification}]}},
Rest3};
_ ->
- throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module),
- [got,get_token(hd(Rest2)),expected,'}']}})
+ {ComponentTypeLists,Rest3}=
+ parse_ComponentTypeLists2(Rest2,[#'EXTENSIONMARK'{pos=Line}]),
+ case Rest3 of
+ [{'}',_}|Rest4] ->
+ {#type{def=#'SET'{components=ComponentTypeLists}},Rest4};
+ _ ->
+ parse_error(Rest3)
+ end
end;
parse_BuiltinType([{'SET',_},{'{',_}|Rest]) ->
{ComponentTypeLists,Rest2} = parse_ComponentTypeLists(Rest),
- case Rest2 of
+ case Rest2 of
[{'}',_}|Rest3] ->
ComponentTypeLists2 =
case {[Ext||Ext = #'EXTENSIONMARK'{} <- ComponentTypeLists],
@@ -597,184 +552,128 @@ parse_BuiltinType([{'SET',_},{'{',_}|Rest]) ->
{#type{def=#'SET'{components = ComponentTypeLists2}},
Rest3};
_ ->
- throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module),
- [got,get_token(hd(Rest2)),expected,'}']}})
+ parse_error(Rest2)
end;
-
-parse_BuiltinType([{'SET',_},{'OF',_},Id={identifier,_,_},Lt={'<',_}|Rest]) ->
-%% TODO: take care of the identifier for something useful
- {Type,Rest2} = parse_SelectionType([Id,Lt|Rest]),
- {#type{def={'SET OF',#type{def=Type,tag=[]}}},Rest2};
-
-
-parse_BuiltinType([{'SET',_},{'OF',_},{identifier,_,_}|Rest]) ->
+parse_BuiltinType([{'SET',_},{'OF',_}|
+ [#identifier{},{'<',_}|_]=Tokens0]) ->
+ {Type,Tokens} = parse_SelectionType(Tokens0),
+ {#type{def={'SET OF',Type}},Tokens};
+parse_BuiltinType([{'SET',_},{'OF',_},#identifier{}|Rest]) ->
%%TODO: take care of the identifier for something useful
{Type,Rest2} = parse_Type(Rest),
{#type{def={'SET OF',Type}},Rest2};
-
parse_BuiltinType([{'SET',_},{'OF',_}|Rest]) ->
{Type,Rest2} = parse_Type(Rest),
{#type{def={'SET OF',Type}},Rest2};
-
-%% The so called Useful types
parse_BuiltinType([{'GeneralizedTime',_}|Rest]) ->
{#type{def='GeneralizedTime'},Rest};
parse_BuiltinType([{'UTCTime',_}|Rest]) ->
{#type{def='UTCTime'},Rest};
parse_BuiltinType([{'ObjectDescriptor',_}|Rest]) ->
{#type{def='ObjectDescriptor'},Rest};
-
-%% For compatibility with old standard
-parse_BuiltinType([{'ANY',_},{'DEFINED',_},{'BY',_},{identifier,_,Id}|Rest]) ->
+parse_BuiltinType([{'ANY',_},{'DEFINED',_},{'BY',_},#identifier{val=Id}|Rest]) ->
+ %% For compatibility with the old standard.
{#type{def={'ANY_DEFINED_BY',Id}},Rest};
parse_BuiltinType([{'ANY',_}|Rest]) ->
+ %% For compatibility with the old standard.
{#type{def='ANY'},Rest};
-
parse_BuiltinType(Tokens) ->
parse_ObjectClassFieldType(Tokens).
-% throw({asn1_error,unhandled_type}).
-parse_TypeWithConstraint([{'SEQUENCE',_},Lpar = {'(',_}|Rest]) ->
- {Constraint,Rest2} = parse_Constraint([Lpar|Rest]),
+parse_TypeWithConstraint([{'SEQUENCE',_}|[{'(',_}|_]=Rest0]) ->
+ {Constraint,Rest2} = parse_Constraint(Rest0),
Rest4 = case Rest2 of
- [{'OF',_}, {identifier,_,_Id}|Rest3] ->
+ [{'OF',_},#identifier{}|Rest3] ->
%%% TODO: make some use of the identifier, maybe useful in the XML mapping
Rest3;
[{'OF',_}|Rest3] ->
Rest3;
_ ->
- throw({asn1_error,
- {get_line(hd(Rest2)),get(asn1_module),
- [got,get_token(hd(Rest2)),expected,'OF']}})
+ parse_error(Rest2)
end,
{Type,Rest5} = parse_Type(Rest4),
{#type{def = {'SEQUENCE OF',Type},
constraint = merge_constraints([Constraint])},Rest5};
-parse_TypeWithConstraint([{'SEQUENCE',_},{'SIZE',_},Lpar = {'(',_}|Rest]) ->
- {Constraint,Rest2} = parse_Constraint([Lpar|Rest]),
+parse_TypeWithConstraint([{'SEQUENCE',_},{'SIZE',_}|[{'(',_}|_]=Rest0]) ->
+ {Constraint,Rest2} = parse_Constraint(Rest0),
#constraint{c=C} = Constraint,
- Constraint2 = Constraint#constraint{c={'SizeConstraint',C}},
+ Constraint2 = Constraint#constraint{c={element_set,{'SizeConstraint',C},
+ none}},
Rest4 = case Rest2 of
- [{'OF',_}, {identifier,_,_Id}|Rest3] ->
+ [{'OF',_},#identifier{}|Rest3] ->
%%% TODO: make some use of the identifier, maybe useful in the XML mapping
Rest3;
[{'OF',_}|Rest3] ->
Rest3;
_ ->
- throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module),
- [got,get_token(hd(Rest2)),expected,'OF']}})
+ parse_error(Rest2)
end,
{Type,Rest5} = parse_Type(Rest4),
{#type{def = {'SEQUENCE OF',Type}, constraint = merge_constraints([Constraint2])},Rest5};
-parse_TypeWithConstraint([{'SET',_},Lpar = {'(',_}|Rest]) ->
- {Constraint,Rest2} = parse_Constraint([Lpar|Rest]),
+parse_TypeWithConstraint([{'SET',_}|[{'(',_}|_]=Rest0]) ->
+ {Constraint,Rest2} = parse_Constraint(Rest0),
Rest4 = case Rest2 of
- [{'OF',_}, {identifier,_,_Id}|Rest3] ->
+ [{'OF',_},#identifier{}|Rest3] ->
%%% TODO: make some use of the identifier, maybe useful in the XML mapping
Rest3;
[{'OF',_}|Rest3] ->
Rest3;
_ ->
- throw({asn1_error,
- {get_line(hd(Rest2)),get(asn1_module),
- [got,get_token(hd(Rest2)),expected,'OF']}})
+ parse_error(Rest2)
end,
{Type,Rest5} = parse_Type(Rest4),
{#type{def = {'SET OF',Type},
constraint = merge_constraints([Constraint])},Rest5};
-parse_TypeWithConstraint([{'SET',_},{'SIZE',_},Lpar = {'(',_}|Rest]) ->
- {Constraint,Rest2} = parse_Constraint([Lpar|Rest]),
+parse_TypeWithConstraint([{'SET',_},{'SIZE',_}|[{'(',_}|_]=Rest0]) ->
+ {Constraint,Rest2} = parse_Constraint(Rest0),
#constraint{c=C} = Constraint,
- Constraint2 = Constraint#constraint{c={'SizeConstraint',C}},
+ Constraint2 = Constraint#constraint{c={element_set,
+ {'SizeConstraint',C},none}},
Rest4 = case Rest2 of
- [{'OF',_}, {identifier,_,_Id}|Rest3] ->
+ [{'OF',_},#identifier{}|Rest3] ->
%%% TODO: make some use of the identifier, maybe useful in the XML mapping
Rest3;
[{'OF',_}|Rest3] ->
Rest3;
_ ->
- throw({asn1_error,
- {get_line(hd(Rest2)),get(asn1_module),
- [got,get_token(hd(Rest2)),expected,'OF']}})
+ parse_error(Rest2)
end,
{Type,Rest5} = parse_Type(Rest4),
{#type{def = {'SET OF',Type},
constraint = merge_constraints([Constraint2])},Rest5};
parse_TypeWithConstraint(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,
- ['SEQUENCE','SEQUENCE SIZE','SET','SET SIZE'],
- followed,by,a,constraint]}}).
+ parse_error(Tokens).
%% --------------------------
parse_ReferencedType(Tokens) ->
- Flist = [fun parse_DefinedType/1,
+ Flist = [fun parse_ParameterizedType/1,
+ fun parse_DefinedType/1,
fun parse_SelectionType/1,
- fun parse_TypeFromObject/1,
- fun parse_ValueSetFromObjects/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_} ->
- throw(AsnErr);
- Result ->
- Result
- end.
+ fun parse_TypeFromObject/1],
+ parse_or(Tokens, Flist).
-parse_DefinedType(Tokens=[{typereference,_,_},{'{',_}|_Rest]) ->
- parse_ParameterizedType(Tokens);
-parse_DefinedType(Tokens=[{typereference,L1,TypeName},
- T2={typereference,_,_},T3={'{',_}|Rest]) ->
- case (catch parse_ParameterizedType(Tokens)) of
- {'EXIT',_Reason} ->
- Rest2 = [T2,T3|Rest],
- {#type{def = #'Externaltypereference'{pos=L1,
- module=resolve_module(TypeName),
- type=TypeName}},Rest2};
- {asn1_error,_} ->
- Rest2 = [T2,T3|Rest],
- {#type{def = #'Externaltypereference'{pos=L1,
- module=resolve_module(TypeName),
- type=TypeName}},Rest2};
- Result ->
- Result
- end;
-parse_DefinedType(Tokens=[{typereference,_L1,_Module},{'.',_},
- {typereference,_,_TypeName},{'{',_}|_Rest]) ->
- parse_ParameterizedType(Tokens);
-parse_DefinedType([{typereference,L1,Module},{'.',_},{typereference,_,TypeName}|Rest]) ->
- {#type{def = #'Externaltypereference'{pos=L1,module=Module,type=TypeName}},Rest};
-parse_DefinedType([{typereference,L1,TypeName}|Rest]) ->
- case is_pre_defined_class(TypeName) of
- false ->
- {#type{def = #'Externaltypereference'{pos=L1,module=resolve_module(TypeName),
- type=TypeName}},Rest};
- _ ->
- throw({asn1_error,
- {L1,get(asn1_module),
- [got,TypeName,expected,
- [typereference,'typereference.typereference',
- 'typereference typereference']]}})
- end;
+parse_DefinedType([{typereference,L1,Module},
+ {'.',_},
+ {typereference,_,TypeName}|Tokens]) ->
+ {#type{def = #'Externaltypereference'{pos=L1,module=Module,
+ type=TypeName}},Tokens};
+parse_DefinedType([{typereference,_,_}=Tr|Tokens]) ->
+ {#type{def=tref2Exttref(Tr)},Tokens};
parse_DefinedType(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,
- [typereference,'typereference.typereference',
- 'typereference typereference']]}}).
+ parse_error(Tokens).
-parse_SelectionType([{identifier,_,Name},{'<',_}|Rest]) ->
+parse_SelectionType([#identifier{val=Name},{'<',_}|Rest]) ->
{Type,Rest2} = parse_Type(Rest),
- {{'SelectionType',Name,Type},Rest2};
+ {#type{def={'SelectionType',Name,Type}},Rest2};
parse_SelectionType(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,'identifier <']}}).
+ parse_error(Tokens).
resolve_module(Type) ->
@@ -787,30 +686,13 @@ resolve_module(_Type, Current, undefined) ->
resolve_module(Type, Current, Imports) ->
case [Mod || #'SymbolsFromModule'{symbols = S, module = Mod} <- Imports,
#'Externaltypereference'{type = T} <- S,
- Type == T] of
+ Type =:= T] of
[#'Externaltypereference'{type = Mod}|_] -> Mod;
%% This allows the same symbol to be imported several times
%% which ought to be checked elsewhere and flagged as an error
[] -> Current
end.
-%% --------------------------
-
-
-%% This should probably be removed very soon
-% parse_ConstrainedType(Tokens) ->
-% case (catch parse_TypeWithConstraint(Tokens)) of
-% {'EXIT',Reason} ->
-% {Type,Rest} = parse_Type(Tokens),
-% {Constraint,Rest2} = parse_Constraint(Rest),
-% {Type#type{constraint=Constraint},Rest2};
-% {asn1_error,Reason2} ->
-% {Type,Rest} = parse_Type(Tokens),
-% {Constraint,Rest2} = parse_Constraint(Rest),
-% {Type#type{constraint=Constraint},Rest2};
-% Result ->
-% Result
-% end.
parse_Constraints(Tokens) ->
parse_Constraints(Tokens,[]).
@@ -819,9 +701,9 @@ parse_Constraints(Tokens,Acc) ->
{Constraint,Rest} = parse_Constraint(Tokens),
case Rest of
[{'(',_}|_Rest2] ->
- parse_Constraints(Rest,[Constraint|Acc]);
+ parse_Constraints(Rest, [Constraint|Acc]);
_ ->
- {lists:reverse([Constraint|Acc]),Rest}
+ {lists:reverse(Acc, [Constraint]),Rest}
end.
parse_Constraint([{'(',_}|Rest]) ->
@@ -830,46 +712,27 @@ parse_Constraint([{'(',_}|Rest]) ->
case Rest3 of
[{')',_}|Rest4] ->
{#constraint{c=Constraint,e=Exception},Rest4};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,')']}})
- end;
-parse_Constraint(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,'(']}}).
+ [_|_] ->
+ parse_error(Rest3)
+ end.
parse_ConstraintSpec(Tokens) ->
Flist = [fun parse_GeneralConstraint/1,
fun parse_SubtypeConstraint/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- {asn1_error,Reason2} ->
- throw({asn1_error,Reason2});
- Result ->
- Result
- end.
+ parse_or(Tokens, Flist).
parse_ExceptionSpec([LPar={')',_}|Rest]) ->
{undefined,[LPar|Rest]};
parse_ExceptionSpec([{'!',_}|Rest]) ->
parse_ExceptionIdentification(Rest);
parse_ExceptionSpec(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,[')','!']]}}).
+ parse_error(Tokens).
parse_ExceptionIdentification(Tokens) ->
Flist = [fun parse_SignedNumber/1,
fun parse_DefinedValue/1,
fun parse_TypeColonValue/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- {asn1_error,Reason2} ->
- throw({asn1_error,Reason2});
- Result ->
- Result
- end.
+ parse_or(Tokens, Flist).
parse_TypeColonValue(Tokens) ->
{Type,Rest} = parse_Type(Tokens),
@@ -877,32 +740,28 @@ parse_TypeColonValue(Tokens) ->
[{':',_}|Rest2] ->
{Value,Rest3} = parse_Value(Rest2),
{{Type,Value},Rest3};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,':']}})
+ [_|_] ->
+ parse_error(Rest)
end.
parse_SubtypeConstraint(Tokens) ->
parse_ElementSetSpecs(Tokens).
-parse_ElementSetSpecs([{'...',_}|Rest]) ->
- {Elements,Rest2} = parse_ElementSetSpec(Rest),
- {{[],Elements},Rest2};
parse_ElementSetSpecs(Tokens) ->
{RootElems,Rest} = parse_ElementSetSpec(Tokens),
case Rest of
[{',',_},{'...',_},{',',_}|Rest2] ->
{AdditionalElems,Rest3} = parse_ElementSetSpec(Rest2),
- {{RootElems,AdditionalElems},Rest3};
+ {{element_set,RootElems,AdditionalElems},Rest3};
[{',',_},{'...',_}|Rest2] ->
- {{RootElems,[]},Rest2};
+ {{element_set,RootElems,empty},Rest2};
_ ->
- {RootElems,Rest}
+ {{element_set,RootElems,none},Rest}
end.
parse_ElementSetSpec([{'ALL',_},{'EXCEPT',_}|Rest]) ->
{Exclusions,Rest2} = parse_Elements(Rest),
- {{'ALL',{'EXCEPT',Exclusions}},Rest2};
+ {{'ALL-EXCEPT',Exclusions},Rest2};
parse_ElementSetSpec(Tokens) ->
parse_Unions(Tokens).
@@ -918,14 +777,8 @@ parse_Unions(Tokens) ->
case {InterSec,Unions} of
{InterSec,[]} ->
{InterSec,Rest2};
- {{'SingleValue',V1},{'SingleValue',V2}} ->
- {{'SingleValue',ordsets:union(to_set(V1),to_set(V2))},Rest2};
- {V1,V2} when is_list(V2) ->
- {[V1] ++ [union|V2],Rest2};
{V1,V2} ->
- {[V1,union,V2],Rest2}
-% Other ->
-% throw(Other)
+ {{union,V1,V2},Rest2}
end.
parse_UnionsRec([{'|',_}|Rest]) ->
@@ -934,12 +787,8 @@ parse_UnionsRec([{'|',_}|Rest]) ->
case {InterSec,URec} of
{V1,[]} ->
{V1,Rest3};
- {{'SingleValue',V1},{'SingleValue',V2}} ->
- {{'SingleValue',ordsets:union(to_set(V1),to_set(V2))},Rest3};
- {V1,V2} when is_list(V2) ->
- {[V1] ++ [union|V2],Rest3};
{V1,V2} ->
- {[V1,union,V2],Rest3}
+ {{union,V1,V2},Rest3}
end;
parse_UnionsRec([{'UNION',Info}|Rest]) ->
parse_UnionsRec([{'|',Info}|Rest]);
@@ -952,13 +801,8 @@ parse_Intersections(Tokens) ->
case {InterSec,IRec} of
{V1,[]} ->
{V1,Rest2};
- {{'SingleValue',V1},{'SingleValue',V2}} ->
- {{'SingleValue',
- ordsets:intersection(to_set(V1),to_set(V2))},Rest2};
- {V1,V2} when is_list(V2) ->
- {[V1] ++ [intersection|V2],Rest2};
{V1,V2} ->
- {[V1,intersection,V2],Rest2}
+ {{intersection,V1,V2},Rest2}
end.
%% parse_IElemsRec(Tokens) -> Result
@@ -967,15 +811,10 @@ parse_IElemsRec([{'^',_}|Rest]) ->
{InterSec,Rest2} = parse_IntersectionElements(Rest),
{IRec,Rest3} = parse_IElemsRec(Rest2),
case {InterSec,IRec} of
- {{'SingleValue',V1},{'SingleValue',V2}} ->
- {{'SingleValue',
- ordsets:intersection(to_set(V1),to_set(V2))},Rest3};
{V1,[]} ->
- {V1,Rest3};
- {V1,V2} when is_list(V2) ->
- {[V1] ++ [intersection|V2],Rest3};
+ {V1,Rest2};
{V1,V2} ->
- {[V1,intersection,V2],Rest3}
+ {{intersection,V1,V2},Rest3}
end;
parse_IElemsRec([{'INTERSECTION',Info}|Rest]) ->
parse_IElemsRec([{'^',Info}|Rest]);
@@ -992,7 +831,7 @@ parse_IntersectionElements(Tokens) ->
case Rest of
[{'EXCEPT',_}|Rest2] ->
{Exclusion,Rest3} = parse_Elements(Rest2),
- {{InterSec,{'EXCEPT',Exclusion}},Rest3};
+ {{'EXCEPT',InterSec,Exclusion},Rest3};
Rest ->
{InterSec,Rest}
end.
@@ -1006,102 +845,73 @@ parse_Elements([{'(',_}|Rest]) ->
case Rest2 of
[{')',_}|Rest3] ->
{Elems,Rest3};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,')']}})
+ [_|_] ->
+ parse_error(Rest2)
end;
parse_Elements(Tokens) ->
Flist = [fun parse_ObjectSetElements/1,
fun parse_SubtypeElements/1,
-% fun parse_Value/1,
-% fun parse_Type/1,
fun parse_Object/1,
fun parse_DefinedObjectSet/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- Err = {asn1_error,_} ->
- throw(Err);
- Result = {Val,_} when is_record(Val,type) ->
- Result;
-
- Result ->
- Result
- end.
-
-
+ parse_or(Tokens, Flist).
%% --------------------------
-parse_DefinedObjectClass([{typereference,_,_ModName},{'.',_},Tr={typereference,_,_ObjClName}|Rest]) ->
-%% {{objectclassname,ModName,ObjClName},Rest};
-% {{objectclassname,tref2Exttref(Tr)},Rest};
- {tref2Exttref(Tr),Rest};
+parse_DefinedObjectClass([{typereference,_,ModName},{'.',_},
+ {typereference,Pos,Name}|Tokens]) ->
+ Ext = #'Externaltypereference'{pos=Pos,
+ module=ModName,
+ type=Name},
+ {Ext,Tokens};
parse_DefinedObjectClass([Tr={typereference,_,_ObjClName}|Rest]) ->
-% {{objectclassname,tref2Exttref(Tr)},Rest};
{tref2Exttref(Tr),Rest};
parse_DefinedObjectClass(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,
- ['typereference . typereference',
- typereference,
- 'TYPE-IDENTIFIER',
- 'ABSTRACT-SYNTAX']]}}).
-
-parse_ObjectClassAssignment([{typereference,L1,ObjClName},{'::=',_}|Rest]) ->
- {Type,Rest2} = parse_ObjectClass(Rest),
- {#classdef{pos=L1,name=ObjClName,module=resolve_module(Type),
- typespec=Type},Rest2};
-parse_ObjectClassAssignment(Tokens) ->
- throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,
- 'typereference ::=']}}).
+ parse_error(Tokens).
parse_ObjectClass(Tokens) ->
- Flist = [fun parse_DefinedObjectClass/1,
- fun parse_ObjectClassDefn/1,
- fun parse_ParameterizedObjectClass/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- {asn1_error,Reason2} ->
- throw({asn1_error,Reason2});
- Result ->
- Result
- end.
+ Flist = [fun parse_ObjectClassDefn/1,
+ fun parse_DefinedObjectClass/1],
+ parse_or(Tokens, Flist).
parse_ObjectClassDefn([{'CLASS',_},{'{',_}|Rest]) ->
{Type,Rest2} = parse_FieldSpec(Rest),
{WithSyntaxSpec,Rest3} = parse_WithSyntaxSpec(Rest2),
{#objectclass{fields=Type,syntax=WithSyntaxSpec},Rest3};
parse_ObjectClassDefn(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,'CLASS {']}}).
+ parse_error(Tokens).
parse_FieldSpec(Tokens) ->
parse_FieldSpec(Tokens,[]).
-parse_FieldSpec(Tokens,Acc) ->
- Flist = [fun parse_FixedTypeValueFieldSpec/1,
- fun parse_VariableTypeValueFieldSpec/1,
- fun parse_ObjectFieldSpec/1,
- fun parse_FixedTypeValueSetFieldSpec/1,
- fun parse_VariableTypeValueSetFieldSpec/1,
- fun parse_TypeFieldSpec/1,
- fun parse_ObjectSetFieldSpec/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_} ->
- throw(AsnErr);
+parse_FieldSpec(Tokens0, Acc) ->
+ Fl = case Tokens0 of
+ [{valuefieldreference,_,_}|_] ->
+ %% 1) &field Type
+ %% &object CLASS-NAME
+ %% 2) &field &FieldName
+ %% A fixed type field cannot be distinguished from
+ %% an object field without type information.
+ [fun parse_FixedTypeValueFieldSpec/1,
+ fun parse_VariableTypeValueFieldSpec/1];
+ [{typefieldreference,_,_}|_] ->
+ %% 1) &Set Type
+ %% &ObjectSet CLASS-NAME
+ %% 2) &Set &FieldName
+ %% 3) &Type
+ %% A value set and an object cannot be distinguished
+ %% without type information.
+ [fun parse_FixedTypeValueSetFieldSpec/1,
+ fun parse_VariableTypeValueSetFieldSpec/1,
+ fun parse_TypeFieldSpec/1];
+ [_|_] ->
+ parse_error(Tokens0)
+ end,
+ case parse_or(Tokens0, Fl) of
{Type,[{'}',_}|Rest]} ->
- {lists:reverse([Type|Acc]),Rest};
+ {lists:reverse(Acc, [Type]),Rest};
{Type,[{',',_}|Rest2]} ->
- parse_FieldSpec(Rest2,[Type|Acc]);
- {_,[H|_T]} ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,'}']}})
+ parse_FieldSpec(Rest2, [Type|Acc])
end.
parse_PrimitiveFieldName([{typefieldreference,_,FieldName}|Rest]) ->
@@ -1109,27 +919,19 @@ parse_PrimitiveFieldName([{typefieldreference,_,FieldName}|Rest]) ->
parse_PrimitiveFieldName([{valuefieldreference,_,FieldName}|Rest]) ->
{{valuefieldreference,FieldName},Rest};
parse_PrimitiveFieldName(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,
- [typefieldreference,valuefieldreference]]}}).
+ parse_error(Tokens).
parse_FieldName(Tokens) ->
{Field,Rest} = parse_PrimitiveFieldName(Tokens),
parse_FieldName(Rest,[Field]).
-parse_FieldName([{'.',_}|Rest],Acc) ->
- case (catch parse_PrimitiveFieldName(Rest)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_} ->
- throw(AsnErr);
- {FieldName,Rest2} ->
- parse_FieldName(Rest2,[FieldName|Acc])
- end;
-parse_FieldName(Tokens,Acc) ->
+parse_FieldName([{'.',_}|Rest0],Acc) ->
+ {FieldName,Rest1} = parse_PrimitiveFieldName(Rest0),
+ parse_FieldName(Rest1, [FieldName|Acc]);
+parse_FieldName(Tokens, Acc) ->
{lists:reverse(Acc),Tokens}.
-parse_FixedTypeValueFieldSpec([{valuefieldreference,L1,VFieldName}|Rest]) ->
+parse_FixedTypeValueFieldSpec([{valuefieldreference,_,VFieldName}|Rest]) ->
{Type,Rest2} = parse_Type(Rest),
{Unique,Rest3} =
case Rest2 of
@@ -1139,109 +941,61 @@ parse_FixedTypeValueFieldSpec([{valuefieldreference,L1,VFieldName}|Rest]) ->
{undefined,Rest2}
end,
{OptionalitySpec,Rest5} = parse_ValueOptionalitySpec(Rest3),
- case {Unique,Rest5} of
- {'UNIQUE',[{Del,_}|_]} when Del =:= ','; Del =:= '}' ->
- case OptionalitySpec of
- {'DEFAULT',_} ->
- throw({asn1_error,
- {L1,get(asn1_module),
- ['UNIQUE and DEFAULT in same field',VFieldName]}});
- _ ->
- {{fixedtypevaluefield,VFieldName,Type,Unique,OptionalitySpec},Rest5}
- end;
- {_,[{Del,_}|_]} when Del =:= ','; Del =:= '}' ->
- {{object_or_fixedtypevalue_field,VFieldName,Type,Unique,OptionalitySpec},Rest5};
- _ ->
- throw({asn1_error,{L1,get(asn1_module),
- [got,get_token(hd(Rest5)),expected,[',','}']]}})
- end;
-parse_FixedTypeValueFieldSpec(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,valuefieldreference]}}).
+ case is_end_delimiter(Rest5) of
+ false -> parse_error(Rest5);
+ true -> ok
+ end,
+ Tag = case Unique of
+ 'UNIQUE' -> fixedtypevaluefield;
+ _ -> object_or_fixedtypevalue_field
+ end,
+ {{Tag,VFieldName,Type,Unique,OptionalitySpec},Rest5}.
+
+parse_VariableTypeValueFieldSpec([{valuefieldreference,_,VFieldName}|Rest0]) ->
+ {FieldRef,Rest1} = parse_FieldName(Rest0),
+ {OptionalitySpec,Rest} = parse_ValueOptionalitySpec(Rest1),
+ case is_end_delimiter(Rest) of
+ true ->
+ {{variabletypevaluefield,VFieldName,FieldRef,OptionalitySpec},
+ Rest};
+ false ->
+ parse_error(Rest)
+ end.
-parse_VariableTypeValueFieldSpec([{valuefieldreference,L,VFieldName}|Rest]) ->
- {FieldRef,Rest2} = parse_FieldName(Rest),
- {OptionalitySpec,Rest3} = parse_ValueOptionalitySpec(Rest2),
- case Rest3 of
- [{Del,_}|_] when Del =:= ','; Del =:= '}' ->
- {{variabletypevaluefield,VFieldName,FieldRef,OptionalitySpec},Rest3};
- _ ->
- throw({asn1_error,{L,get(asn1_module),
- [got,get_token(hd(Rest3)),expected,[',','}']]}})
- end;
-parse_VariableTypeValueFieldSpec(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,valuefieldreference]}}).
+parse_TypeFieldSpec([{typefieldreference,_,Name}|Rest0]) ->
+ {OptionalitySpec,Rest} = parse_TypeOptionalitySpec(Rest0),
+ case is_end_delimiter(Rest) of
+ true ->
+ {{typefield,Name,OptionalitySpec},Rest};
+ false ->
+ parse_error(Rest)
+ end.
-parse_ObjectFieldSpec([{valuefieldreference,L,VFieldName}|Rest]) ->
- {Class,Rest2} = parse_DefinedObjectClass(Rest),
- {OptionalitySpec,Rest3} = parse_ObjectOptionalitySpec(Rest2),
- case Rest3 of
- [{Del,_}|_] when Del =:= ','; Del =:= '}' ->
- {{objectfield,VFieldName,Class,undefined,OptionalitySpec},Rest3};
- _ ->
- throw({asn1_error,{L,get(asn1_module),
- [got,get_token(hd(Rest3)),expected,[',','}']]}})
- end;
-parse_ObjectFieldSpec(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,valuefieldreference]}}).
+parse_FixedTypeValueSetFieldSpec([{typefieldreference,_,Name}|Rest0]) ->
+ {Type,Rest1} = parse_Type(Rest0),
+ {OptionalitySpec,Rest} = parse_ValueSetOptionalitySpec(Rest1),
+ case is_end_delimiter(Rest) of
+ true ->
+ {{objectset_or_fixedtypevalueset_field,Name,Type,
+ OptionalitySpec},Rest};
+ false ->
+ parse_error(Rest)
+ end.
-parse_TypeFieldSpec([{typefieldreference,L,TFieldName}|Rest]) ->
- {OptionalitySpec,Rest2} = parse_TypeOptionalitySpec(Rest),
- case Rest2 of
- [{Del,_}|_] when Del =:= ','; Del =:= '}' ->
- {{typefield,TFieldName,OptionalitySpec},Rest2};
- _ ->
- throw({asn1_error,{L,get(asn1_module),
- [got,get_token(hd(Rest2)),expected,[',','}']]}})
- end;
-parse_TypeFieldSpec(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,typefieldreference]}}).
+parse_VariableTypeValueSetFieldSpec([{typefieldreference,_,Name}|Rest0]) ->
+ {FieldRef,Rest1} = parse_FieldName(Rest0),
+ {OptionalitySpec,Rest} = parse_ValueSetOptionalitySpec(Rest1),
+ case is_end_delimiter(Rest) of
+ true ->
+ {{variabletypevaluesetfield,Name,FieldRef,OptionalitySpec},
+ Rest};
+ false ->
+ parse_error(Rest)
+ end.
-parse_FixedTypeValueSetFieldSpec([{typefieldreference,L,TFieldName}|Rest]) ->
- {Type,Rest2} = parse_Type(Rest),
- {OptionalitySpec,Rest3} = parse_ValueSetOptionalitySpec(Rest2),
- case Rest3 of
- [{Del,_}|_] when Del =:= ','; Del =:= '}' ->
- {{objectset_or_fixedtypevalueset_field,TFieldName,Type,
- OptionalitySpec},Rest3};
- _ ->
- throw({asn1_error,{L,get(asn1_module),
- [got,get_token(hd(Rest3)),expected,[',','}']]}})
- end;
-parse_FixedTypeValueSetFieldSpec(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,typefieldreference]}}).
-
-parse_VariableTypeValueSetFieldSpec([{typefieldreference,L,TFieldName}|Rest]) ->
- {FieldRef,Rest2} = parse_FieldName(Rest),
- {OptionalitySpec,Rest3} = parse_ValueSetOptionalitySpec(Rest2),
- case Rest3 of
- [{Del,_}|_] when Del =:= ','; Del =:= '}' ->
- {{variabletypevaluesetfield,TFieldName,FieldRef,OptionalitySpec},Rest3};
- _ ->
- throw({asn1_error,{L,get(asn1_module),
- [got,get_token(hd(Rest3)),expected,[',','}']]}})
- end;
-parse_VariableTypeValueSetFieldSpec(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,typefieldreference]}}).
-
-parse_ObjectSetFieldSpec([{typefieldreference,L,TFieldName}|Rest]) ->
- {Class,Rest2} = parse_DefinedObjectClass(Rest),
- {OptionalitySpec,Rest3} = parse_ObjectSetOptionalitySpec(Rest2),
- case Rest3 of
- [{Del,_}|_] when Del =:= ','; Del =:= '}' ->
- {{objectsetfield,TFieldName,Class,OptionalitySpec},Rest3};
- _ ->
- throw({asn1_error,{L,get(asn1_module),
- [got,get_token(hd(Rest3)),expected,[',','}']]}})
- end;
-parse_ObjectSetFieldSpec(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,typefieldreference]}}).
+is_end_delimiter([{',',_}|_]) -> true;
+is_end_delimiter([{'}',_}|_]) -> true;
+is_end_delimiter([_|_]) -> false.
parse_ValueOptionalitySpec(Tokens)->
case Tokens of
@@ -1252,15 +1006,6 @@ parse_ValueOptionalitySpec(Tokens)->
_ -> {'MANDATORY',Tokens}
end.
-parse_ObjectOptionalitySpec(Tokens) ->
- case Tokens of
- [{'OPTIONAL',_}|Rest] -> {'OPTIONAL',Rest};
- [{'DEFAULT',_}|Rest] ->
- {Object,Rest2} = parse_Object(Rest),
- {{'DEFAULT',Object},Rest2};
- _ -> {'MANDATORY',Tokens}
- end.
-
parse_TypeOptionalitySpec(Tokens) ->
case Tokens of
[{'OPTIONAL',_}|Rest] -> {'OPTIONAL',Rest};
@@ -1279,65 +1024,44 @@ parse_ValueSetOptionalitySpec(Tokens) ->
_ -> {'MANDATORY',Tokens}
end.
-parse_ObjectSetOptionalitySpec(Tokens) ->
- case Tokens of
- [{'OPTIONAL',_}|Rest] -> {'OPTIONAL',Rest};
- [{'DEFAULT',_}|Rest] ->
- {ObjectSet,Rest2} = parse_ObjectSet(Rest),
- {{'DEFAULT',ObjectSet},Rest2};
- _ -> {'MANDATORY',Tokens}
- end.
-
parse_WithSyntaxSpec([{'WITH',_},{'SYNTAX',_}|Rest]) ->
{SyntaxList,Rest2} = parse_SyntaxList(Rest),
{{'WITH SYNTAX',SyntaxList},Rest2};
parse_WithSyntaxSpec(Tokens) ->
{[],Tokens}.
-parse_SyntaxList([{'{',_},{'}',_}|Rest]) ->
- {[],Rest};
parse_SyntaxList([{'{',_}|Rest]) ->
parse_SyntaxList(Rest,[]);
parse_SyntaxList(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,['{}','{']]}}).
+ parse_error(Tokens).
-parse_SyntaxList(Tokens,Acc) ->
+parse_SyntaxList(Tokens, Acc) ->
{SyntaxList,Rest} = parse_TokenOrGroupSpec(Tokens),
case Rest of
[{'}',_}|Rest2] ->
- {lists:reverse([SyntaxList|Acc]),Rest2};
+ {lists:reverse(Acc, [SyntaxList]),Rest2};
_ ->
- parse_SyntaxList(Rest,[SyntaxList|Acc])
+ parse_SyntaxList(Rest, [SyntaxList|Acc])
end.
parse_TokenOrGroupSpec(Tokens) ->
Flist = [fun parse_RequiredToken/1,
fun parse_OptionalGroup/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_} ->
- throw(AsnErr);
- Result ->
- Result
- end.
+ parse_or(Tokens, Flist).
-parse_RequiredToken([{typereference,L1,WordName}|Rest]) ->
+parse_RequiredToken([{typereference,_,WordName}|Rest]=Tokens) ->
case is_word(WordName) of
false ->
- throw({asn1_error,{L1,get(asn1_module),
- [got,WordName,expected,a,'Word']}});
+ parse_error(Tokens);
true ->
{WordName,Rest}
end;
parse_RequiredToken([{',',L1}|Rest]) ->
{{',',L1},Rest};
-parse_RequiredToken([{WordName,L1}|Rest]) ->
+parse_RequiredToken([{WordName,_}|Rest]=Tokens) ->
case is_word(WordName) of
false ->
- throw({asn1_error,{L1,get(asn1_module),
- [got,WordName,expected,a,'Word']}});
+ parse_error(Tokens);
true ->
{WordName,Rest}
end;
@@ -1347,7 +1071,9 @@ parse_RequiredToken(Tokens) ->
parse_OptionalGroup([{'[',_}|Rest]) ->
{Spec,Rest2} = parse_TokenOrGroupSpec(Rest),
{SpecList,Rest3} = parse_OptionalGroup(Rest2,[Spec]),
- {SpecList,Rest3}.
+ {SpecList,Rest3};
+parse_OptionalGroup(Tokens) ->
+ parse_error(Tokens).
parse_OptionalGroup([{']',_}|Rest],Acc) ->
{lists:reverse(Acc),Rest};
@@ -1355,82 +1081,55 @@ parse_OptionalGroup(Tokens,Acc) ->
{Spec,Rest} = parse_TokenOrGroupSpec(Tokens),
parse_OptionalGroup(Rest,[Spec|Acc]).
-parse_DefinedObject([Id={identifier,_,_ObjName}|Rest]) ->
+parse_DefinedObject([#identifier{}=Id|Rest]) ->
{{object,identifier2Extvalueref(Id)},Rest};
-parse_DefinedObject([{typereference,L1,ModName},{'.',_},{identifier,_,ObjName}|Rest]) ->
+parse_DefinedObject([{typereference,L1,ModName},{'.',_},#identifier{val=ObjName}|Rest]) ->
{{object, #'Externaltypereference'{pos=L1,module=ModName,type=ObjName}},Rest};
parse_DefinedObject(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,
- [identifier,'typereference.identifier']]}}).
+ parse_error(Tokens).
-parse_ObjectAssignment([{identifier,L1,ObjName}|Rest]) ->
+parse_ObjectAssignment([#identifier{pos=L1,val=ObjName}|Rest]) ->
{Class,Rest2} = parse_DefinedObjectClass(Rest),
case Rest2 of
[{'::=',_}|Rest3] ->
{Object,Rest4} = parse_Object(Rest3),
{#typedef{pos=L1,name=ObjName,
typespec=#'Object'{classname=Class,def=Object}},Rest4};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,'::=']}});
- Other ->
- throw({asn1_error,{L1,get(asn1_module),
- [got,Other,expected,'::=']}})
- end;
-parse_ObjectAssignment(Tokens) ->
- throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,identifier]}}).
-
+ _ ->
+ parse_error(Rest2)
+ end.
%% parse_Object(Tokens) -> Ret
%% Tokens = [Tok]
%% Tok = tuple()
%% Ret = {object,_} | {object, _, _}
parse_Object(Tokens) ->
- Flist=[fun parse_ObjectDefn/1,
- fun parse_ObjectFromObject/1,
- fun parse_ParameterizedObject/1,
- fun parse_DefinedObject/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_} ->
- throw(AsnErr);
- Result ->
- Result
- end.
+ %% The ObjectFromObject production is not included here,
+ %% since it will have been catched by the ValueFromObject
+ %% before we reach this point.
+ Flist = [fun parse_ObjectDefn/1,
+ fun parse_DefinedObject/1],
+ parse_or(Tokens, Flist).
parse_ObjectDefn(Tokens) ->
Flist=[fun parse_DefaultSyntax/1,
fun parse_DefinedSyntax/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_} ->
- throw(AsnErr);
- Result ->
- Result
- end.
+ parse_or(Tokens, Flist).
-parse_DefaultSyntax([{'{',_},{'}',_}|Rest]) ->
- {{object,defaultsyntax,[]},Rest};
parse_DefaultSyntax([{'{',_}|Rest]) ->
parse_DefaultSyntax(Rest,[]);
parse_DefaultSyntax(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,['{}','{']]}}).
+ parse_error(Tokens).
-parse_DefaultSyntax(Tokens,Acc) ->
+parse_DefaultSyntax(Tokens, Acc) ->
{Setting,Rest} = parse_FieldSetting(Tokens),
case Rest of
[{',',_}|Rest2] ->
parse_DefaultSyntax(Rest2,[Setting|Acc]);
[{'}',_}|Rest3] ->
- {{object,defaultsyntax,lists:reverse([Setting|Acc])},Rest3};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,[',','}']]}})
+ {{object,defaultsyntax,lists:reverse(Acc, [Setting])},Rest3};
+ _ ->
+ parse_error(Rest)
end.
parse_FieldSetting(Tokens) ->
@@ -1439,7 +1138,9 @@ parse_FieldSetting(Tokens) ->
{{PrimFieldName,Setting},Rest2}.
parse_DefinedSyntax([{'{',_}|Rest]) ->
- parse_DefinedSyntax(Rest,[]).
+ parse_DefinedSyntax(Rest, []);
+parse_DefinedSyntax(Tokens) ->
+ parse_error(Tokens).
parse_DefinedSyntax(Tokens,Acc) ->
case Tokens of
@@ -1455,95 +1156,70 @@ parse_DefinedSyntax(Tokens,Acc) ->
%% Literal ::= word | ','
%% Setting ::= Type | Value | ValueSet | Object | ObjectSet
%% word equals typereference, but no lower cases
-parse_DefinedSyntaxToken([{',',L1}|Rest]) ->
- {{',',L1},Rest};
+parse_DefinedSyntaxToken([{',',_}=Comma|Rest]) ->
+ {Comma,Rest};
%% ObjectClassFieldType or a defined type with a constraint.
%% Should also be able to parse a parameterized type. It may be
%% impossible to distinguish between a parameterized type and a Literal
%% followed by an object set.
-parse_DefinedSyntaxToken(Tokens=[{typereference,L1,_Name},{T,_}|_Rest])
- when T == '.'; T == '(' ->
- case catch parse_Setting(Tokens) of
- {asn1_error,_} ->
- throw({asn1_error,{L1,get(asn1_module),
- [got,hd(Tokens), expected,['Word',setting]]}});
- {'EXIT',Reason} ->
- exit(Reason);
- Result ->
- Result
- end;
-parse_DefinedSyntaxToken(Tokens=[TRef={typereference,L1,Name}|Rest]) ->
+parse_DefinedSyntaxToken([{typereference,_,_Name},{T,_}|_]=Tokens)
+ when T =:= '.'; T =:= '(' ->
+ parse_Setting(Tokens);
+parse_DefinedSyntaxToken([{typereference,L1,Name}=TRef|Rest]=Tokens) ->
case is_word(Name) of
false ->
case lookahead_definedsyntax(Rest) of
word_or_setting ->
{{setting,L1,tref2Exttref(TRef)},Rest};
- _ ->
+ setting ->
parse_Setting(Tokens)
end;
true ->
- %% {{word_or_setting,L1,Name},Rest}
{{word_or_setting,L1,tref2Exttref(TRef)},Rest}
end;
parse_DefinedSyntaxToken(Tokens) ->
- case catch parse_Setting(Tokens) of
- {asn1_error,_} ->
- parse_Word(Tokens);
- {'EXIT',Reason} ->
- exit(Reason);
- Result ->
+ try parse_Setting(Tokens) of
+ {_,_}=Result ->
Result
+ catch
+ throw:{asn1_error,_} ->
+ parse_Word(Tokens)
end.
lookahead_definedsyntax([{typereference,_,Name}|_Rest]) ->
- case is_word(Name) of
+ case is_word(Name) of
true -> word_or_setting;
- _ -> setting
+ false -> setting
end;
lookahead_definedsyntax([{'}',_}|_Rest]) ->
word_or_setting;
lookahead_definedsyntax(_) ->
setting.
-parse_Word([{Name,Pos}|Rest]) ->
+parse_Word([{Name,Pos}|Rest]=Tokens) ->
case is_word(Name) of
false ->
- throw({asn1_error,{Pos,get(asn1_module),
- [got,Name, expected,a,'Word']}});
+ parse_error(Tokens);
true ->
{{word_or_setting,Pos,tref2Exttref(Pos,Name)},Rest}
- end.
+ end;
+parse_Word(Tokens) ->
+ parse_error(Tokens).
parse_Setting(Tokens) ->
Flist = [{type_tag,fun parse_Type/1},
{value_tag,fun parse_Value/1},
{object_tag,fun parse_Object/1},
{objectset_tag,fun parse_ObjectSet/1}],
- case (catch parse_or_tag(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_} ->
- throw(AsnErr);
- Result = {{value_tag,_},_} ->
+ case parse_or_tag(Tokens, Flist) of
+ {{value_tag,_},_}=Result ->
+ %% Keep the value_tag.
Result;
{{Tag,Setting},Rest} when is_atom(Tag) ->
+ %% Remove all other tags.
{Setting,Rest}
end.
-%% parse_Setting(Tokens) ->
-%% Flist = [fun parse_Type/1,
-%% fun parse_Value/1,
-%% fun parse_Object/1,
-%% fun parse_ObjectSet/1],
-%% case (catch parse_or(Tokens,Flist)) of
-%% {'EXIT',Reason} ->
-%% exit(Reason);
-%% AsnErr = {asn1_error,_} ->
-%% throw(AsnErr);
-%% Result ->
-%% Result
-%% end.
-
parse_DefinedObjectSet([{typereference,L1,ModuleName},{'.',_},
{typereference,L2,ObjSetName}|Rest]) ->
{{objectset,L1,#'Externaltypereference'{pos=L2,module=ModuleName,
@@ -1552,9 +1228,7 @@ parse_DefinedObjectSet([{typereference,L1,ObjSetName}|Rest]) ->
{{objectset,L1,#'Externaltypereference'{pos=L1,module=resolve_module(ObjSetName),
type=ObjSetName}},Rest};
parse_DefinedObjectSet(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,
- [typereference,'typereference.typereference']]}}).
+ parse_error(Tokens).
parse_ObjectSetAssignment([{typereference,L1,ObjSetName}|Rest]) ->
{Class,Rest2} = parse_DefinedObjectClass(Rest),
@@ -1564,16 +1238,9 @@ parse_ObjectSetAssignment([{typereference,L1,ObjSetName}|Rest]) ->
{#typedef{pos=L1,name=ObjSetName,
typespec=#'ObjectSet'{class=Class,
set=ObjectSet}},Rest4};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,'::=']}})
-%%% Other ->
-%%% throw(Other)
- end;
-parse_ObjectSetAssignment(Tokens) ->
- throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,
- typereference]}}).
+ _ ->
+ parse_error(Rest2)
+ end.
%% parse_ObjectSet(Tokens) -> {Ret,Rest}
%% Tokens = [Tok]
@@ -1590,26 +1257,20 @@ parse_ObjectSet([{'{',_}|Rest]) ->
case Rest2 of
[{'}',_}|Rest3] ->
{ObjSetSpec,Rest3};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,'}']}})
+ _ ->
+ parse_error(Rest2)
end;
parse_ObjectSet(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,'{']}}).
+ parse_error(Tokens).
-parse_ObjectSetSpec([{'...',_}|Rest]) ->
- case Rest of
- [{',',_}|Rest2] ->
- {Elements,Rest3}=parse_ElementSetSpecs(Rest2),
- {{[],Elements},Rest3};
- _ ->
- {['EXTENSIONMARK'],Rest}
- end;
+parse_ObjectSetSpec([{'...',_},{',',_}|Tokens0]) ->
+ {Elements,Tokens} = parse_ElementSetSpec(Tokens0),
+ {{element_set,empty,Elements},Tokens};
+parse_ObjectSetSpec([{'...',_}|Tokens]) ->
+ {{element_set,empty,empty},Tokens};
parse_ObjectSetSpec(Tokens) ->
parse_ElementSetSpecs(Tokens).
-% moved fun parse_Object/1 and fun parse_DefinedObjectSet/1 to parse_Elements
%% parse_ObjectSetElements(Tokens) -> {Result,Rest}
%% Result ::= {'ObjectSetFromObjects',Objects,Name} | {pos,ObjectSet,Params}
%% Objects ::= ReferencedObjects
@@ -1619,18 +1280,9 @@ parse_ObjectSetSpec(Tokens) ->
%% ObjectSet ::= {objectset,integer(),#'Externaltypereference'{}}
%% Params ::= list() (see parse_ActualParameterList/1)
parse_ObjectSetElements(Tokens) ->
- Flist = [%fun parse_Object/1,
- %fun parse_DefinedObjectSet/1,
- fun parse_ObjectSetFromObjects/1,
+ Flist = [fun parse_ObjectSetFromObjects/1,
fun parse_ParameterizedObjectSet/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_} ->
- throw(AsnErr);
- Result ->
- Result
- end.
+ parse_or(Tokens, Flist).
parse_ObjectClassFieldType(Tokens) ->
{Class,Rest} = parse_DefinedObjectClass(Tokens),
@@ -1641,25 +1293,10 @@ parse_ObjectClassFieldType(Tokens) ->
classname=Class,
class=Class,fieldname=FieldName},
{#type{def=OCFT},Rest3};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,'.']}})
-%%% Other ->
-%%% throw(Other)
+ _ ->
+ parse_error(Rest)
end.
-%parse_ObjectClassFieldValue(Tokens) ->
-% Flist = [fun parse_OpenTypeFieldVal/1,
-% fun parse_FixedTypeFieldVal/1],
-% case (catch parse_or(Tokens,Flist)) of
-% {'EXIT',Reason} ->
-% throw(Reason);
-% AsnErr = {asn1_error,_} ->
-% throw(AsnErr);
-% Result ->
-% Result
-% end.
-
parse_ObjectClassFieldValue(Tokens) ->
parse_OpenTypeFieldVal(Tokens).
@@ -1669,28 +1306,10 @@ parse_OpenTypeFieldVal(Tokens) ->
[{':',_}|Rest2] ->
{Value,Rest3} = parse_Value(Rest2),
{{opentypefieldvalue,Type,Value},Rest3};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,':']}})
+ _ ->
+ parse_error(Rest)
end.
-% parse_FixedTypeFieldVal(Tokens) ->
-% parse_Value(Tokens).
-
-% parse_InformationFromObjects(Tokens) ->
-% Flist = [fun parse_ValueFromObject/1,
-% fun parse_ValueSetFromObjects/1,
-% fun parse_TypeFromObject/1,
-% fun parse_ObjectFromObject/1],
-% case (catch parse_or(Tokens,Flist)) of
-% {'EXIT',Reason} ->
-% throw(Reason);
-% AsnErr = {asn1_error,_} ->
-% throw(AsnErr);
-% Result ->
-% Result
-% end.
-
%% parse_ReferencedObjects(Tokens) -> {Result,Rest}
%% Result ::= DefObject | DefObjSet |
%% {po,DefObject,Params} | {pos,DefObjSet,Params} |
@@ -1702,18 +1321,11 @@ parse_OpenTypeFieldVal(Tokens) ->
parse_ReferencedObjects(Tokens) ->
Flist = [fun parse_DefinedObject/1,
fun parse_DefinedObjectSet/1,
- fun parse_ParameterizedObject/1,
fun parse_ParameterizedObjectSet/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_} ->
- throw(AsnErr);
- Result ->
- Result
- end.
+ parse_or(Tokens, Flist).
parse_ValueFromObject(Tokens) ->
+ %% This production also matches ObjectFromObject.
{Objects,Rest} = parse_ReferencedObjects(Tokens),
case Rest of
[{'.',_}|Rest2] ->
@@ -1722,35 +1334,10 @@ parse_ValueFromObject(Tokens) ->
{valuefieldreference,_} ->
{{'ValueFromObject',Objects,Name},Rest3};
_ ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,typefieldreference,expected,
- valuefieldreference]}})
+ parse_error(Rest2)
end;
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,'.']}})
-%%% Other ->
-%%% throw({asn1_error,{got,Other,expected,'.'}})
- end.
-
-parse_ValueSetFromObjects(Tokens) ->
- {Objects,Rest} = parse_ReferencedObjects(Tokens),
- case Rest of
- [{'.',_}|Rest2] ->
- {Name,Rest3} = parse_FieldName(Rest2),
- case lists:last(Name) of
- {typefieldreference,_FieldName} ->
- {{'ValueSetFromObjects',Objects,Name},Rest3};
- _ ->
- throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module),
- [got,get_token(hd(Rest2)),expected,
- typefieldreference]}})
- end;
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,'.']}})
-%%% Other ->
-%%% throw({asn1_error,{got,Other,expected,'.'}})
+ _ ->
+ parse_error(Rest)
end.
parse_TypeFromObject(Tokens) ->
@@ -1760,28 +1347,12 @@ parse_TypeFromObject(Tokens) ->
{Name,Rest3} = parse_FieldName(Rest2),
case lists:last(Name) of
{typefieldreference,_FieldName} ->
- {{'TypeFromObject',Objects,Name},Rest3};
+ {#type{def={'TypeFromObject',Objects,Name}},Rest3};
_ ->
- throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module),
- [got,get_token(hd(Rest2)),expected,
- typefieldreference]}})
+ parse_error(Rest2)
end;
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,'.']}})
-%%% Other ->
-%%% throw({asn1_error,{got,Other,expected,'.'}})
- end.
-
-parse_ObjectFromObject(Tokens) ->
- {Objects,Rest} = parse_ReferencedObjects(Tokens),
- case Rest of
- [{'.',_}|Rest2] ->
- {Name,Rest3} = parse_FieldName(Rest2),
- {{'ObjectFromObject',Objects,Name},Rest3};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,'.']}})
+ _ ->
+ parse_error(Rest)
end.
%% parse_ObjectSetFromObjects(Tokens) -> {Result,Rest}
@@ -1799,23 +1370,12 @@ parse_ObjectSetFromObjects(Tokens) ->
{typefieldreference,_FieldName} ->
{{'ObjectSetFromObjects',Objects,Name},Rest3};
_ ->
- throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module),
- [got,get_token(hd(Rest2)),expected,
- typefieldreference]}})
+ parse_error(Rest2)
end;
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,'.']}})
+ _ ->
+ parse_error(Rest)
end.
-% parse_InstanceOfType([{'INSTANCE',_},{'OF',_}|Rest]) ->
-% {Class,Rest2} = parse_DefinedObjectClass(Rest),
-% {{'InstanceOfType',Class},Rest2}.
-
-% parse_InstanceOfValue(Tokens) ->
-% parse_Value(Tokens).
-
-
%% X.682 constraint specification
@@ -1823,14 +1383,7 @@ parse_GeneralConstraint(Tokens) ->
Flist = [fun parse_UserDefinedConstraint/1,
fun parse_TableConstraint/1,
fun parse_ContentsConstraint/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_} ->
- throw(AsnErr);
- Result ->
- Result
- end.
+ parse_or(Tokens, Flist).
parse_UserDefinedConstraint([{'CONSTRAINED',_},{'BY',_},{'{',_},{'}',_}|Rest])->
{{constrained_by,[]},Rest};
@@ -1841,32 +1394,23 @@ parse_UserDefinedConstraint([{'CONSTRAINED',_},
case Rest2 of
[{'}',_}|Rest3] ->
{{constrained_by,Param},Rest3};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,'}']}})
+ _ ->
+ parse_error(Rest2)
end;
parse_UserDefinedConstraint(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,
- ['CONSTRAINED BY {}','CONSTRAINED BY {']]}}).
+ parse_error(Tokens).
parse_UserDefinedConstraintParameter(Tokens) ->
- parse_UserDefinedConstraintParameter(Tokens,[]).
-parse_UserDefinedConstraintParameter(Tokens,Acc) ->
+ parse_UserDefinedConstraintParameter(Tokens, []).
+
+parse_UserDefinedConstraintParameter(Tokens0, Acc) ->
Flist = [fun parse_GovernorAndActualParameter/1,
fun parse_ActualParameter/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_} ->
- throw(AsnErr);
- {Result,Rest} ->
- case Rest of
- [{',',_}|_Rest2] ->
- parse_UserDefinedConstraintParameter(Tokens,[Result|Acc]);
- _ ->
- {lists:reverse([Result|Acc]),Rest}
- end
+ case parse_or(Tokens0, Flist) of
+ {Result,[{',',_}|Tokens]} ->
+ parse_UserDefinedConstraintParameter(Tokens, [Result|Acc]);
+ {Result,Tokens} ->
+ {lists:reverse(Acc, [Result]),Tokens}
end.
parse_GovernorAndActualParameter(Tokens) ->
@@ -1875,26 +1419,18 @@ parse_GovernorAndActualParameter(Tokens) ->
[{':',_}|Rest2] ->
{Params,Rest3} = parse_ActualParameter(Rest2),
{{'Governor_Params',Governor,Params},Rest3};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,':']}})
+ _ ->
+ parse_error(Rest)
end.
parse_TableConstraint(Tokens) ->
Flist = [fun parse_ComponentRelationConstraint/1,
fun parse_SimpleTableConstraint/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_} ->
- throw(AsnErr);
- Result ->
- Result
- end.
+ parse_or(Tokens, Flist).
parse_SimpleTableConstraint(Tokens) ->
{ObjectSet,Rest} = parse_ObjectSet(Tokens),
- {{simpletable,ObjectSet},Rest}.
+ {{element_set,{simpletable,ObjectSet},none},Rest}.
parse_ComponentRelationConstraint([{'{',_}|Rest]) ->
{ObjectSet,Rest2} = parse_DefinedObjectSet(Rest),
@@ -1903,21 +1439,18 @@ parse_ComponentRelationConstraint([{'{',_}|Rest]) ->
{AtNot,Rest4} = parse_AtNotationList(Rest3,[]),
case Rest4 of
[{'}',_}|Rest5] ->
- {{componentrelation,ObjectSet,AtNot},Rest5};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,'}']}})
+ Ret = {element_set,
+ {componentrelation,ObjectSet,AtNot},
+ none},
+ {Ret,Rest5};
+ _ ->
+ parse_error(Rest4)
end;
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,
- 'ComponentRelationConstraint',ended,with,'}']}})
-%%% Other ->
-%%% throw(Other)
+ _ ->
+ parse_error(Rest2)
end;
parse_ComponentRelationConstraint(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,'{']}}).
+ parse_error(Tokens).
parse_AtNotationList(Tokens,Acc) ->
{AtNot,Rest} = parse_AtNotation(Tokens),
@@ -1925,7 +1458,7 @@ parse_AtNotationList(Tokens,Acc) ->
[{',',_}|Rest2] ->
parse_AtNotationList(Rest2,[AtNot|Acc]);
_ ->
- {lists:reverse([AtNot|Acc]),Rest}
+ {lists:reverse(Acc, [AtNot]),Rest}
end.
parse_AtNotation([{'@',_},{'.',_}|Rest]) ->
@@ -1935,20 +1468,17 @@ parse_AtNotation([{'@',_}|Rest]) ->
{CIdList,Rest2} = parse_ComponentIdList(Rest),
{{outermost,CIdList},Rest2};
parse_AtNotation(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,['@','@.']]}}).
+ parse_error(Tokens).
parse_ComponentIdList(Tokens) ->
parse_ComponentIdList(Tokens,[]).
-parse_ComponentIdList([Id = {identifier,_,_},{'.',_}|Rest],Acc) ->
+parse_ComponentIdList([#identifier{}=Id,{'.',_}|Rest], Acc) ->
parse_ComponentIdList(Rest,[identifier2Extvalueref(Id)|Acc]);
-parse_ComponentIdList([Id = {identifier,_,_}|Rest],Acc) ->
- {lists:reverse([identifier2Extvalueref(Id)|Acc]),Rest};
+parse_ComponentIdList([#identifier{}=Id|Rest], Acc) ->
+ {lists:reverse(Acc, [identifier2Extvalueref(Id)]),Rest};
parse_ComponentIdList(Tokens,_) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,
- [identifier,'identifier.']]}}).
+ parse_error(Tokens).
parse_ContentsConstraint([{'CONTAINING',_}|Rest]) ->
{Type,Rest2} = parse_Type(Rest),
@@ -1963,24 +1493,14 @@ parse_ContentsConstraint([{'ENCODED',_},{'BY',_}|Rest]) ->
{Value,Rest2} = parse_Value(Rest),
{{contentsconstraint,[],Value},Rest2};
parse_ContentsConstraint(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,
- 'CONTAINING','or','ENCODED BY']}}).
-
+ parse_error(Tokens).
% X.683 Parameterization of ASN.1 specifications
parse_Governor(Tokens) ->
Flist = [fun parse_Type/1,
fun parse_DefinedObjectClass/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_} ->
- throw(AsnErr);
- Result ->
- Result
- end.
+ parse_or(Tokens, Flist).
parse_ActualParameter(Tokens) ->
Flist = [fun parse_Type/1,
@@ -1989,32 +1509,7 @@ parse_ActualParameter(Tokens) ->
fun parse_DefinedObjectClass/1,
fun parse_Object/1,
fun parse_ObjectSet/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_} ->
- throw(AsnErr);
- Result ->
- Result
- end.
-
-parse_ParameterizedAssignment(Tokens) ->
- Flist = [fun parse_ParameterizedTypeAssignment/1,
- fun parse_ParameterizedValueAssignment/1,
- fun parse_ParameterizedValueSetTypeAssignment/1,
- fun parse_ParameterizedObjectClassAssignment/1,
- fun parse_ParameterizedObjectAssignment/1,
- fun parse_ParameterizedObjectSetAssignment/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_} ->
- throw(AsnErr);
- AsnAssErr = {asn1_assignment_error,_} ->
- throw(AsnAssErr);
- Result ->
- Result
- end.
+ parse_or(Tokens, Flist).
%% parse_ParameterizedTypeAssignment(Tokens) -> Result
%% Result = {#ptypedef{},Rest} | throw()
@@ -2025,18 +1520,13 @@ parse_ParameterizedTypeAssignment([{typereference,L1,Name}|Rest]) ->
{Type,Rest4} = parse_Type(Rest3),
{#ptypedef{pos=L1,name=Name,args=ParameterList,typespec=Type},
Rest4};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,'::=']}})
- end;
-parse_ParameterizedTypeAssignment(Tokens) ->
- throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,
- typereference]}}).
+ _ ->
+ parse_error(Rest2)
+ end.
%% parse_ParameterizedValueAssignment(Tokens) -> Result
%% Result = {#pvaluedef{},Rest} | throw()
-parse_ParameterizedValueAssignment([{identifier,L1,Name}|Rest]) ->
+parse_ParameterizedValueAssignment([#identifier{pos=L1,val=Name}|Rest]) ->
{ParameterList,Rest2} = parse_ParameterList(Rest),
{Type,Rest3} = parse_Type(Rest2),
case Rest3 of
@@ -2044,13 +1534,9 @@ parse_ParameterizedValueAssignment([{identifier,L1,Name}|Rest]) ->
{Value,Rest5} = parse_Value(Rest4),
{#pvaluedef{pos=L1,name=Name,args=ParameterList,type=Type,
value=Value},Rest5};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,'::=']}})
- end;
-parse_ParameterizedValueAssignment(Tokens) ->
- throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,identifier]}}).
+ _ ->
+ parse_error(Rest3)
+ end.
%% parse_ParameterizedValueSetTypeAssignment(Tokens) -> Result
%% Result = {#pvaluesetdef{},Rest} | throw()
@@ -2062,14 +1548,9 @@ parse_ParameterizedValueSetTypeAssignment([{typereference,L1,Name}|Rest]) ->
{ValueSet,Rest5} = parse_ValueSet(Rest4),
{#pvaluesetdef{pos=L1,name=Name,args=ParameterList,
type=Type,valueset=ValueSet},Rest5};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,'::=']}})
- end;
-parse_ParameterizedValueSetTypeAssignment(Tokens) ->
- throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,
- typereference]}}).
+ _ ->
+ parse_error(Rest3)
+ end.
%% parse_ParameterizedObjectClassAssignment(Tokens) -> Result
%% Result = {#ptypedef{},Rest} | throw()
@@ -2080,18 +1561,13 @@ parse_ParameterizedObjectClassAssignment([{typereference,L1,Name}|Rest]) ->
{Class,Rest4} = parse_ObjectClass(Rest3),
{#ptypedef{pos=L1,name=Name,args=ParameterList,typespec=Class},
Rest4};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,'::=']}})
- end;
-parse_ParameterizedObjectClassAssignment(Tokens) ->
- throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,
- typereference]}}).
+ _ ->
+ parse_error(Rest2)
+ end.
%% parse_ParameterizedObjectAssignment(Tokens) -> Result
%% Result = {#pobjectdef{},Rest} | throw()
-parse_ParameterizedObjectAssignment([{identifier,L1,Name}|Rest]) ->
+parse_ParameterizedObjectAssignment([#identifier{pos=L1,val=Name}|Rest]) ->
{ParameterList,Rest2} = parse_ParameterList(Rest),
{Class,Rest3} = parse_DefinedObjectClass(Rest2),
case Rest3 of
@@ -2099,36 +1575,9 @@ parse_ParameterizedObjectAssignment([{identifier,L1,Name}|Rest]) ->
{Object,Rest5} = parse_Object(Rest4),
{#pobjectdef{pos=L1,name=Name,args=ParameterList,
class=Class,def=Object},Rest5};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,'::=']}})
-%%% Other ->
-%%% throw(Other)
- end;
-parse_ParameterizedObjectAssignment(Tokens) ->
- throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,identifier]}}).
-
-%% parse_ParameterizedObjectSetAssignment(Tokens) -> Result
-%% Result = {#pobjectsetdef{},Rest} | throw{}
-parse_ParameterizedObjectSetAssignment([{typereference,L1,Name}|Rest]) ->
- {ParameterList,Rest2} = parse_ParameterList(Rest),
- {Class,Rest3} = parse_DefinedObjectClass(Rest2),
- case Rest3 of
- [{'::=',_}|Rest4] ->
- {ObjectSet,Rest5} = parse_ObjectSet(Rest4),
- {#pobjectsetdef{pos=L1,name=Name,args=ParameterList,
- class=Class,def=ObjectSet},Rest5};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,'::=']}})
-%%% Other ->
-%%% throw(Other)
- end;
-parse_ParameterizedObjectSetAssignment(Tokens) ->
- throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,
- typereference]}}).
+ _ ->
+ parse_error(Rest3)
+ end.
%% parse_ParameterList(Tokens) -> Result
%% Result = [Parameter]
@@ -2137,35 +1586,24 @@ parse_ParameterizedObjectSetAssignment(Tokens) ->
%% Type = #type{}
%% DefinedObjectClass = #'Externaltypereference'{}
%% Reference = #'Externaltypereference'{} | #'Externalvaluereference'{}
-parse_ParameterList([{'{',_}|Rest]) ->
- parse_ParameterList(Rest,[]);
-parse_ParameterList(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,'{']}}).
+parse_ParameterList([{'{',_}|Tokens]) ->
+ parse_ParameterList(Tokens, []).
parse_ParameterList(Tokens,Acc) ->
{Parameter,Rest} = parse_Parameter(Tokens),
case Rest of
[{',',_}|Rest2] ->
- parse_ParameterList(Rest2,[Parameter|Acc]);
+ parse_ParameterList(Rest2, [Parameter|Acc]);
[{'}',_}|Rest3] ->
- {lists:reverse([Parameter|Acc]),Rest3};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,[',','}']]}})
+ {lists:reverse(Acc, [Parameter]),Rest3};
+ _ ->
+ parse_error(Rest)
end.
parse_Parameter(Tokens) ->
Flist = [fun parse_ParamGovAndRef/1,
fun parse_Reference/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_} ->
- throw(AsnErr);
- Result ->
- Result
- end.
+ parse_or(Tokens, Flist).
parse_ParamGovAndRef(Tokens) ->
{ParamGov,Rest} = parse_ParamGovernor(Tokens),
@@ -2173,86 +1611,54 @@ parse_ParamGovAndRef(Tokens) ->
[{':',_}|Rest2] ->
{Ref,Rest3} = parse_Reference(Rest2),
{{ParamGov,Ref},Rest3};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,':']}})
+ _ ->
+ parse_error(Rest)
end.
parse_ParamGovernor(Tokens) ->
Flist = [fun parse_Governor/1,
fun parse_Reference/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_} ->
- throw(AsnErr);
- Result ->
- Result
- end.
-
-% parse_ParameterizedReference(Tokens) ->
-% {Ref,Rest} = parse_Reference(Tokens),
-% case Rest of
-% [{'{',_},{'}',_}|Rest2] ->
-% {{ptref,Ref},Rest2};
-% _ ->
-% {{ptref,Ref},Rest}
-% end.
+ parse_or(Tokens, Flist).
parse_SimpleDefinedType([{typereference,L1,ModuleName},{'.',_},
{typereference,_,TypeName}|Rest]) ->
{#'Externaltypereference'{pos=L1,module=ModuleName,
type=TypeName},Rest};
parse_SimpleDefinedType([Tref={typereference,_,_}|Rest]) ->
-% {#'Externaltypereference'{pos=L2,module=get(asn1_module),
-% type=TypeName},Rest};
{tref2Exttref(Tref),Rest};
parse_SimpleDefinedType(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,
- [typereference,'typereference.typereference']]}}).
+ parse_error(Tokens).
parse_SimpleDefinedValue([{typereference,L1,ModuleName},{'.',_},
- {identifier,_,Value}|Rest]) ->
+ #identifier{val=Value}|Rest]) ->
{{simpledefinedvalue,#'Externalvaluereference'{pos=L1,module=ModuleName,
value=Value}},Rest};
-parse_SimpleDefinedValue([Id={identifier,_,_Value}|Rest]) ->
+parse_SimpleDefinedValue([#identifier{}=Id|Rest]) ->
{{simpledefinedvalue,identifier2Extvalueref(Id)},Rest};
parse_SimpleDefinedValue(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,
- ['typereference.identifier',identifier]]}}).
+ parse_error(Tokens).
parse_ParameterizedType(Tokens) ->
+ %% May also be a parameterized class.
{Type,Rest} = parse_SimpleDefinedType(Tokens),
{Params,Rest2} = parse_ActualParameterList(Rest),
- {{pt,Type,Params},Rest2}.
+ {#type{def={pt,Type,Params}},Rest2}.
parse_ParameterizedValue(Tokens) ->
+ %% May also be a parameterized object.
{Value,Rest} = parse_SimpleDefinedValue(Tokens),
{Params,Rest2} = parse_ActualParameterList(Rest),
{{pv,Value,Params},Rest2}.
-parse_ParameterizedObjectClass(Tokens) ->
- {Type,Rest} = parse_DefinedObjectClass(Tokens),
- {Params,Rest2} = parse_ActualParameterList(Rest),
- {{poc,Type,Params},Rest2}.
-
parse_ParameterizedObjectSet(Tokens) ->
{ObjectSet,Rest} = parse_DefinedObjectSet(Tokens),
{Params,Rest2} = parse_ActualParameterList(Rest),
{{pos,ObjectSet,Params},Rest2}.
-parse_ParameterizedObject(Tokens) ->
- {Object,Rest} = parse_DefinedObject(Tokens),
- {Params,Rest2} = parse_ActualParameterList(Rest),
- {{po,Object,Params},Rest2}.
-
parse_ActualParameterList([{'{',_}|Rest]) ->
parse_ActualParameterList(Rest,[]);
parse_ActualParameterList(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,'{']}}).
+ parse_error(Tokens).
parse_ActualParameterList(Tokens,Acc) ->
{Parameter,Rest} = parse_ActualParameter(Tokens),
@@ -2260,43 +1666,22 @@ parse_ActualParameterList(Tokens,Acc) ->
[{',',_}|Rest2] ->
parse_ActualParameterList(Rest2,[Parameter|Acc]);
[{'}',_}|Rest3] ->
- {lists:reverse([Parameter|Acc]),Rest3};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,[',','}']]}})
-%%% Other ->
-%%% throw(Other)
+ {lists:reverse(Acc, [Parameter]),Rest3};
+ _ ->
+ parse_error(Rest)
end.
-
-
-
-
-
-
-%-------------------------
-
+%% Test whether Token is allowed in a syntax list.
is_word(Token) ->
- case not_allowed_word(Token) of
+ List = atom_to_list(Token),
+ case not_allowed_word(List) of
true -> false;
- _ ->
- if
- is_atom(Token) ->
- Item = atom_to_list(Token),
- is_word(Item);
- is_list(Token), length(Token) == 1 ->
- check_one_char_word(Token);
- is_list(Token) ->
- [A|Rest] = Token,
- case check_first(A) of
- true ->
- check_rest(Rest);
- _ ->
- false
- end
- end
+ false -> is_word_1(List)
end.
+is_word_1([H|T]) ->
+ check_first(H) andalso check_rest(T).
+
not_allowed_word(Name) ->
lists:member(Name,["BIT",
"BOOLEAN",
@@ -2321,257 +1706,123 @@ not_allowed_word(Name) ->
"TRUE",
"UNION"]).
-check_one_char_word([A]) when $A =< A, $Z >= A ->
- true;
-check_one_char_word([_]) ->
- false. %% unknown item in SyntaxList
+check_first(C) ->
+ $A =< C andalso C =< $Z.
-check_first(A) when $A =< A, $Z >= A ->
- true;
-check_first(_) ->
- false. %% unknown item in SyntaxList
-
-check_rest([R,R|_Rs]) when $- == R ->
- false; %% two consecutive hyphens are not allowed in a word
-check_rest([R]) when $- == R ->
- false; %% word cannot end with hyphen
-check_rest([R|Rs]) when $A=<R, $Z>=R; $-==R ->
+check_rest([R|Rs]) when $A =< R, R =< $Z; R =:= $- ->
check_rest(Rs);
check_rest([]) ->
true;
check_rest(_) ->
false.
+%%%
+%%% Parse alternative type lists for CHOICE.
+%%%
+
+parse_AlternativeTypeLists(Tokens0) ->
+ {Root,Tokens1} = parse_AlternativeTypeList(Tokens0),
+ case Tokens1 of
+ [{',',_}|Tokens2] ->
+ {ExtMarker,Tokens3} = parse_ExtensionAndException(Tokens2),
+ {ExtAlts,Tokens4} = parse_ExtensionAdditionAlternatives(Tokens3),
+ {_,Tokens} = parse_OptionalExtensionMarker(Tokens4, []),
+ {Root++ExtMarker++ExtAlts,Tokens};
+ Tokens ->
+ {Root,Tokens}
+ end.
+
+parse_ExtensionAndException([{'...',L}|Tokens0]) ->
+ {[#'EXTENSIONMARK'{pos=L}],
+ case Tokens0 of
+ [{'!',_}|Tokens1] ->
+ {_,Tokens} = parse_ExceptionIdentification(Tokens1),
+ Tokens;
+ _ ->
+ Tokens0
+ end}.
+
+parse_AlternativeTypeList([#identifier{}|_]=Tokens0) ->
+ {AltType,Tokens} = parse_NamedType(Tokens0),
+ parse_AlternativeTypeList_1(Tokens, [AltType]);
+parse_AlternativeTypeList(Tokens) ->
+ parse_error(Tokens).
+
+parse_AlternativeTypeList_1([{',',_}|[#identifier{}|_]=Tokens0], Acc) ->
+ {AltType,Tokens} = parse_NamedType(Tokens0),
+ parse_AlternativeTypeList_1(Tokens, [AltType|Acc]);
+parse_AlternativeTypeList_1(Tokens, Acc) ->
+ {lists:reverse(Acc),Tokens}.
-to_set(V) when is_list(V) ->
- ordsets:from_list(V);
-to_set(V) ->
- ordsets:from_list([V]).
-
-parse_AlternativeTypeLists(Tokens) ->
- parse_AlternativeTypeLists(Tokens,[]).
-
-parse_AlternativeTypeLists(Tokens = [{identifier,_,_}|_Rest0],Clist) ->
- {CompList,Rest1} = parse_AlternativeTypeList(Tokens,[]),
- parse_AlternativeTypeLists(Rest1,Clist++CompList);
-parse_AlternativeTypeLists([{'...',L1},{'!',_}|Rest02],Clist0) ->
- {_,Rest03} = parse_ExceptionIdentification(Rest02),
- %% Exception info is currently thrown away
- parse_AlternativeTypeLists2(Rest03,Clist0++[#'EXTENSIONMARK'{pos=L1}]);
-parse_AlternativeTypeLists([{',',L1},{'...',_},{'!',_}|Rest02],Clist0) when Clist0 =/= []->
- {_,Rest03} = parse_ExceptionIdentification(Rest02),
- %% Exception info is currently thrown away
- parse_AlternativeTypeLists2(Rest03,Clist0++[#'EXTENSIONMARK'{pos=L1}]);
-
-parse_AlternativeTypeLists([{',',_},{'...',L1}|Rest02],Clist0) when Clist0 =/= []->
- parse_AlternativeTypeLists2(Rest02,Clist0++[#'EXTENSIONMARK'{pos=L1}]);
-parse_AlternativeTypeLists([{'...',L1}|Rest02],Clist0) ->
- parse_AlternativeTypeLists2(Rest02,Clist0++[#'EXTENSIONMARK'{pos=L1}]);
-parse_AlternativeTypeLists(Tokens = [{'}',_L1}|_Rest02],Clist0) ->
- {Clist0,Tokens}.
-
-parse_AlternativeTypeLists2(Tokens,Clist) ->
- {ExtAdd,Rest} = parse_ExtensionAdditionAlternatives(Tokens,Clist),
- {Clist2,Rest2} = parse_OptionalExtensionMarker(Rest,lists:flatten(ExtAdd)),
- case Rest2 of
- [{',',_}|Rest3] ->
- {CompList,Rest4} = parse_AlternativeTypeList(Rest3,[]),
- {Clist2 ++ CompList,Rest4};
- _ ->
- {Clist2,Rest2}
- end.
-
-
-
-parse_AlternativeTypeList([{',',_},Id = {identifier,_,_}|Rest],Acc) when Acc =/= [] ->
- {AlternativeType,Rest2} = parse_NamedType([Id|Rest]),
- parse_AlternativeTypeList(Rest2,[AlternativeType|Acc]);
-parse_AlternativeTypeList(Tokens = [{'}',_}|_],Acc) ->
- {lists:reverse(Acc),Tokens};
-parse_AlternativeTypeList(Tokens = [{']',_},{']',_}|_],Acc) ->
- {lists:reverse(Acc),Tokens};
-parse_AlternativeTypeList(Tokens = [{',',_},{'...',_}|_],Acc) ->
- {lists:reverse(Acc),Tokens};
-parse_AlternativeTypeList(Tokens,[]) ->
- {AlternativeType,Rest} = parse_NamedType(Tokens),
- parse_AlternativeTypeList(Rest,[AlternativeType]);
-parse_AlternativeTypeList(Tokens,_) ->
- throw({asn1_error,
- {get_line(hd(Tokens)),get(asn1_module),
- [got,[get_token(hd(Tokens)),get_token(hd(tl(Tokens)))],
- expected,['}',', identifier']]}}).
-
-parse_ExtensionAdditionAlternatives(Tokens =[{',',_}|_],Clist) ->
- {ExtAddList,Rest2} = parse_ExtensionAdditionAlternativesList(Tokens,[]),
- {Clist++lists:flatten(ExtAddList),Rest2};
-parse_ExtensionAdditionAlternatives(Tokens,Clist) ->
- %% Empty
- {Clist,Tokens}.
+parse_ExtensionAdditionAlternatives([{',',_}|_]=Tokens0) ->
+ parse_ExtensionAdditionAlternativesList(Tokens0, []);
+parse_ExtensionAdditionAlternatives(Tokens) ->
+ {[],Tokens}.
-parse_ExtensionAdditionAlternativesList([{',',_},Id = {identifier,_,_}|Rest],Acc) ->
- {AlternativeType,Rest2} = parse_NamedType([Id|Rest]),
- parse_ExtensionAdditionAlternativesList(Rest2,[AlternativeType|Acc]);
-parse_ExtensionAdditionAlternativesList([{',',_},C1 = {'[',_},C2 = {'[',_}|Rest],Acc) ->
- {ExtAddGroup,Rest2} = parse_ExtensionAdditionAlternativesGroup([C1,C2|Rest],[]),
- parse_ExtensionAdditionAlternativesList(Rest2,[ExtAddGroup|Acc]);
-parse_ExtensionAdditionAlternativesList(Tokens = [{'}',_}|_],Acc) ->
- {lists:reverse(Acc),Tokens};
-parse_ExtensionAdditionAlternativesList(Tokens = [{',',_},{'...',_}|_],Acc) ->
- {lists:reverse(Acc),Tokens};
-parse_ExtensionAdditionAlternativesList(Tokens,_) ->
- throw({asn1_error,
- {get_line(hd(Tokens)),get(asn1_module),
- [got,[get_token(hd(Tokens)),get_token(hd(tl(Tokens)))],
- expected,['}',', identifier']]}}).
-
-
-parse_ExtensionAdditionAlternativesGroup([ {'[',_},{'[',_},_VsnNr = {number,_,Num},{':',_}|Rest],[]) ->
- parse_ExtensionAdditionAlternativesGroup2(Rest,Num);
-parse_ExtensionAdditionAlternativesGroup([ {'[',_},{'[',_}|Rest],[]) ->
- parse_ExtensionAdditionAlternativesGroup2(Rest,undefined);
-parse_ExtensionAdditionAlternativesGroup(Tokens,_) ->
- throw({asn1_error,
- {get_line(hd(Tokens)),get(asn1_module),
- [got,[get_token(hd(Tokens)),get_token(hd(tl(Tokens)))],
- expected,['[[']]}}).
-
-
-parse_ExtensionAdditionAlternativesGroup2(Tokens,Num) ->
- {CompTypeList,Rest} = parse_AlternativeTypeList(Tokens,[]),
- case Rest of
- [{']',_},{']',_}|Rest2] ->
- {[{'ExtensionAdditionGroup',Num}|CompTypeList] ++
- ['ExtensionAdditionGroupEnd'],Rest2};
+parse_ExtensionAdditionAlternativesList([{',',_}|Tokens1]=Tokens0, Acc) ->
+ try parse_ExtensionAdditionAlternative(Tokens1) of
+ {ExtAddAlt,Tokens2} ->
+ parse_ExtensionAdditionAlternativesList(Tokens2, [ExtAddAlt|Acc])
+ catch
+ throw:{asn1_error,_} ->
+ {lists:append(lists:reverse(Acc)),Tokens0}
+ end;
+parse_ExtensionAdditionAlternativesList(Tokens, Acc) ->
+ {lists:append(lists:reverse(Acc)),Tokens}.
+
+parse_ExtensionAdditionAlternative([#identifier{}|_]=Tokens0) ->
+ {NamedType,Tokens} = parse_NamedType(Tokens0),
+ {[NamedType],Tokens};
+parse_ExtensionAdditionAlternative([{'[',_},{'[',_}|Tokens0]) ->
+ Tokens2 = case Tokens0 of
+ [{number,_,_},{':',_}|Tokens1] -> Tokens1;
+ _ -> Tokens0
+ end,
+ {GroupList,Tokens3} = parse_AlternativeTypeList(Tokens2),
+ case Tokens3 of
+ [{']',_},{']',_}|Tokens] ->
+ {GroupList,Tokens};
_ ->
- throw({asn1_error,{get_line(hd(Rest)),get(asn1_module),
- [got,get_token(hd(Rest)),expected,[']]']]}})
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%% parse_AlternativeTypeLists(Tokens,ExtensionDefault) ->
-%% {AltTypeList,Rest1} = parse_AlternativeTypeList(Tokens),
-%% {ExtensionAndException,Rest2} =
-%% case Rest1 of
-%% [{',',_},{'...',L1},{'!',_}|Rest12] ->
-%% {_,Rest13} = parse_ExceptionIdentification(Rest12),
-%% %% Exception info is currently thrown away
-%% {[#'EXTENSIONMARK'{pos=L1}],Rest13};
-%% [{',',_},{'...',L1}|Rest12] ->
-%% {[#'EXTENSIONMARK'{pos=L1}],Rest12};
-%% _ ->
-%% {[],Rest1}
-%% end,
-%% {AltTypeList2,Rest5} =
-%% case ExtensionAndException of
-%% [] ->
-%% {AltTypeList,Rest2};
-%% _ ->
-%% {ExtensionAddition,Rest3} =
-%% case Rest2 of
-%% [{',',_}|Rest23] ->
-%% parse_ExtensionAdditionAlternativeList(Rest23);
-%% _ ->
-%% {[],Rest2}
-%% end,
-%% {OptionalExtensionMarker,Rest4} =
-%% case Rest3 of
-%% [{',',_},{'...',L3}|Rest31] ->
-%% {[#'EXTENSIONMARK'{pos=L3}],Rest31};
-%% _ ->
-%% {[],Rest3}
-%% end,
-%% {AltTypeList ++ ExtensionAndException ++
-%% ExtensionAddition ++ OptionalExtensionMarker, Rest4}
-%% end,
-%% AltTypeList3 =
-%% case [X || X=#'EXTENSIONMARK'{} <- AltTypeList2] of
-%% [] when ExtensionDefault == 'IMPLIED' ->
-%% AltTypeList2 ++ [#'EXTENSIONMARK'{}];
-%% _ ->
-%% AltTypeList2
-%% end,
-%% {AltTypeList3,Rest5}.
-
-
-%% parse_AlternativeTypeList(Tokens) ->
-%% parse_AlternativeTypeList(Tokens,[]).
+ parse_error(Tokens3)
+ end;
+parse_ExtensionAdditionAlternative(Tokens) ->
+ parse_error(Tokens).
-%% parse_AlternativeTypeList(Tokens,Acc) ->
-%% {NamedType,Rest} = parse_NamedType(Tokens),
-%% case Rest of
-%% [{',',_},Id = {identifier,_,_}|Rest2] ->
-%% parse_AlternativeTypeList([Id|Rest2],[NamedType|Acc]);
-%% _ ->
-%% {lists:reverse([NamedType|Acc]),Rest}
-%% end.
+%%%
+%%% End of parsing of alternative type lists.
+%%%
-
-
-%% parse_ExtensionAdditionAlternativeList(Tokens) ->
-%% parse_ExtensionAdditionAlternativeList(Tokens,[]).
-
-%% parse_ExtensionAdditionAlternativeList([{'[[',_}|Rest],Acc) ->
-%% parse_ExtensionAdditionAlternativeList(Rest,Acc);
-%% parse_ExtensionAdditionAlternativeList(Tokens = [{identifier,_,_}|_Rest],Acc) ->
-%% {Element,Rest0} = parse_NamedType(Tokens);
-%% case Rest0 of
-%% [{',',_}|Rest01] ->
-%% parse_ExtensionAdditionAlternativeList(Rest01,[Element|Acc]);
-%% _ ->
-%% {lists:reverse([Element|Acc]),Rest0}
-%% end.
-
-%% parse_ExtensionAdditionAlternatives([{'[[',_}|Rest]) ->
-%% parse_ExtensionAdditionAlternatives(Rest,[]);
-%% parse_ExtensionAdditionAlternatives(Tokens) ->
-%% throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
-%% [got,get_token(hd(Tokens)),expected,'[[']}}).
-
-%% parse_ExtensionAdditionAlternatives([Id = {identifier,_,_}|Rest],Acc) ->
-%% {NamedType, Rest2} = parse_NamedType([Id|Rest]),
-%% case Rest2 of
-%% [{',',_}|Rest21] ->
-%% parse_ExtensionAdditionAlternatives(Rest21,[NamedType|Acc]);
-%% [{']]',_}|Rest21] ->
-%% {lists:reverse(Acc),Rest21};
-%% _ ->
-%% throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module),
-%% [got,get_token(hd(Rest2)),expected,[',',']]']]}})
-%% end.
-
-parse_NamedType([{identifier,L1,Idname}|Rest]) ->
+parse_NamedType([#identifier{pos=L1,val=Idname}|Rest]) ->
{Type,Rest2} = parse_Type(Rest),
{#'ComponentType'{pos=L1,name=Idname,typespec=Type,prop=mandatory},Rest2};
parse_NamedType(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,identifier]}}).
+ parse_error(Tokens).
+%%%
+%%% Parse component type lists for SEQUENCE and SET.
+%%%
parse_ComponentTypeLists(Tokens) ->
- parse_ComponentTypeLists(Tokens,[]).
+ parse_ComponentTypeLists(Tokens, []).
-parse_ComponentTypeLists(Tokens = [{identifier,_,_}|_Rest0],Clist) ->
- {CompList,Rest1} = parse_ComponentTypeList(Tokens,[]),
- parse_ComponentTypeLists(Rest1,Clist++CompList);
-parse_ComponentTypeLists(Tokens = [{'COMPONENTS',_},{'OF',_}|_Rest],Clist) ->
+parse_ComponentTypeLists([#identifier{}|_Rest0]=Tokens, Clist) ->
{CompList,Rest1} = parse_ComponentTypeList(Tokens,[]),
parse_ComponentTypeLists(Rest1,Clist++CompList);
-parse_ComponentTypeLists([{'...',L1},{'!',_}|Rest02],Clist0) ->
- {_,Rest03} = parse_ExceptionIdentification(Rest02),
- %% Exception info is currently thrown away
- parse_ComponentTypeLists2(Rest03,Clist0++[#'EXTENSIONMARK'{pos=L1}]);
+parse_ComponentTypeLists([{'COMPONENTS',_},{'OF',_}|_]=Tokens,Clist) ->
+ {CompList,Rest1} = parse_ComponentTypeList(Tokens, []),
+ parse_ComponentTypeLists(Rest1, Clist++CompList);
parse_ComponentTypeLists([{',',L1},{'...',_},{'!',_}|Rest02],Clist0) when Clist0 =/= []->
{_,Rest03} = parse_ExceptionIdentification(Rest02),
%% Exception info is currently thrown away
parse_ComponentTypeLists2(Rest03,Clist0++[#'EXTENSIONMARK'{pos=L1}]);
-
- parse_ComponentTypeLists([{',',_},{'...',L1}|Rest02],Clist0) when Clist0 =/= []->
+parse_ComponentTypeLists([{',',_},{'...',L1}|Rest02],Clist0) when Clist0 =/= []->
parse_ComponentTypeLists2(Rest02,Clist0++[#'EXTENSIONMARK'{pos=L1}]);
parse_ComponentTypeLists([{'...',L1}|Rest02],Clist0) ->
parse_ComponentTypeLists2(Rest02,Clist0++[#'EXTENSIONMARK'{pos=L1}]);
parse_ComponentTypeLists(Tokens = [{'}',_L1}|_Rest02],Clist0) ->
- {Clist0,Tokens}.
+ {Clist0,Tokens};
+parse_ComponentTypeLists(Tokens, _) ->
+ parse_error(Tokens).
parse_ComponentTypeLists2(Tokens,Clist) ->
{ExtAdd,Rest} = parse_ExtensionAdditions(Tokens,Clist),
@@ -2590,12 +1841,12 @@ parse_OptionalExtensionMarker(Tokens,Clist) ->
{Clist,Tokens}.
-parse_ComponentTypeList([{',',_},Id = {identifier,_,_}|Rest],Acc) when Acc =/= [] ->
- {ComponentType,Rest2} = parse_ComponentType([Id|Rest]),
- parse_ComponentTypeList(Rest2,[ComponentType|Acc]);
-parse_ComponentTypeList([{',',_},C1={'COMPONENTS',_},C2={'OF',_}|Rest],Acc) when Acc =/= [] ->
- {ComponentType,Rest2} = parse_ComponentType([C1,C2|Rest]),
- parse_ComponentTypeList(Rest2,[ComponentType|Acc]);
+parse_ComponentTypeList([{',',_}|[#identifier{}|_]=Tokens0], Acc) when Acc =/= [] ->
+ {ComponentType,Tokens} = parse_ComponentType(Tokens0),
+ parse_ComponentTypeList(Tokens, [ComponentType|Acc]);
+parse_ComponentTypeList([{',',_}|[{'COMPONENTS',_},{'OF',_}|_]=Tokens0], Acc) when Acc =/= [] ->
+ {ComponentType,Tokens} = parse_ComponentType(Tokens0),
+ parse_ComponentTypeList(Tokens, [ComponentType|Acc]);
parse_ComponentTypeList(Tokens = [{'}',_}|_],Acc) ->
{lists:reverse(Acc),Tokens};
parse_ComponentTypeList(Tokens = [{']',_},{']',_}|_],Acc) ->
@@ -2606,10 +1857,7 @@ parse_ComponentTypeList(Tokens,[]) ->
{ComponentType,Rest} = parse_ComponentType(Tokens),
parse_ComponentTypeList(Rest,[ComponentType]);
parse_ComponentTypeList(Tokens,_) ->
- throw({asn1_error,
- {get_line(hd(Tokens)),get(asn1_module),
- [got,[get_token(hd(Tokens)),get_token(hd(tl(Tokens)))],
- expected,['}',', identifier']]}}).
+ parse_error(Tokens).
parse_ExtensionAdditions(Tokens=[{',',_}|_],Clist) ->
{ExtAddList,Rest2} = parse_ExtensionAdditionList(Tokens,[]),
@@ -2618,46 +1866,36 @@ parse_ExtensionAdditions(Tokens,Clist) ->
%% Empty
{Clist,Tokens}.
-parse_ExtensionAdditionList([{',',_},Id = {identifier,_,_}|Rest],Acc) ->
- {ComponentType,Rest2} = parse_ComponentType([Id|Rest]),
- parse_ExtensionAdditionList(Rest2,[ComponentType|Acc]);
-parse_ExtensionAdditionList([{',',_},C1={'COMPONENTS',_},C2={'OF',_}|Rest],Acc) ->
- {ComponentType,Rest2} = parse_ComponentType([C1,C2|Rest]),
- parse_ExtensionAdditionList(Rest2,[ComponentType|Acc]);
-parse_ExtensionAdditionList([{',',_},C1 = {'[',_},C2 = {'[',_}|Rest],Acc) ->
- {ExtAddGroup,Rest2} = parse_ExtensionAdditionGroup([C1,C2|Rest],[]),
+parse_ExtensionAdditionList([{',',_}|[#identifier{}|_]=Tokens0], Acc) ->
+ {ComponentType,Tokens} = parse_ComponentType(Tokens0),
+ parse_ExtensionAdditionList(Tokens, [ComponentType|Acc]);
+parse_ExtensionAdditionList([{',',_}|[{'COMPONENTS',_},{'OF',_}|_]=Tokens0], Acc) ->
+ {ComponentType,Tokens} = parse_ComponentType(Tokens0),
+ parse_ExtensionAdditionList(Tokens, [ComponentType|Acc]);
+parse_ExtensionAdditionList([{',',_},{'[',_},{'[',_}|Tokens], Acc) ->
+ {ExtAddGroup,Rest2} = parse_ExtensionAdditionGroup(Tokens),
parse_ExtensionAdditionList(Rest2,[ExtAddGroup|Acc]);
-parse_ExtensionAdditionList(Tokens = [{'}',_}|_],Acc) ->
+parse_ExtensionAdditionList([{'}',_}|_]=Tokens, Acc) ->
{lists:reverse(Acc),Tokens};
-parse_ExtensionAdditionList(Tokens = [{',',_},{'...',_}|_],Acc) ->
+parse_ExtensionAdditionList([{',',_},{'...',_}|_]=Tokens, Acc) ->
{lists:reverse(Acc),Tokens};
-parse_ExtensionAdditionList(Tokens,_) ->
- throw({asn1_error,
- {get_line(hd(Tokens)),get(asn1_module),
- [got,[get_token(hd(Tokens)),get_token(hd(tl(Tokens)))],
- expected,['}',', identifier']]}}).
-
+parse_ExtensionAdditionList(Tokens, _) ->
+ parse_error(Tokens).
-parse_ExtensionAdditionGroup([ {'[',_},{'[',_},_VsnNr = {number,_,Num},{':',_}|Rest],[]) ->
- parse_ExtensionAdditionGroup2(Rest,Num);
-parse_ExtensionAdditionGroup([ {'[',_},{'[',_}|Rest],[]) ->
- parse_ExtensionAdditionGroup2(Rest,undefined);
-parse_ExtensionAdditionGroup(Tokens,_) ->
- throw({asn1_error,
- {get_line(hd(Tokens)),get(asn1_module),
- [got,[get_token(hd(Tokens)),get_token(hd(tl(Tokens)))],
- expected,['[[']]}}).
+parse_ExtensionAdditionGroup([{number,_,Num},{':',_}|Tokens]) ->
+ parse_ExtensionAdditionGroup2(Tokens, Num);
+parse_ExtensionAdditionGroup(Tokens) ->
+ parse_ExtensionAdditionGroup2(Tokens, undefined).
-parse_ExtensionAdditionGroup2(Tokens,Num) ->
+parse_ExtensionAdditionGroup2(Tokens, Num) ->
{CompTypeList,Rest} = parse_ComponentTypeList(Tokens,[]),
case Rest of
[{']',_},{']',_}|Rest2] ->
{[{'ExtensionAdditionGroup',Num}|CompTypeList] ++
['ExtensionAdditionGroupEnd'],Rest2};
_ ->
- throw({asn1_error,{get_line(hd(Rest)),get(asn1_module),
- [got,get_token(hd(Rest)),expected,[']]']]}})
+ parse_error(Rest)
end.
@@ -2676,83 +1914,81 @@ parse_ComponentType(Tokens) ->
Result
end.
-
+%%%
+%%% Parse ENUMERATED.
+%%%
-parse_SignedNumber([{number,_,Value}|Rest]) ->
- {Value,Rest};
-parse_SignedNumber([{'-',_},{number,_,Value}|Rest]) ->
- {-Value,Rest};
-parse_SignedNumber(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,
- [number,'-number']]}}).
-
-parse_Enumerations(Tokens=[{identifier,_,_}|_Rest],ExtensionDefault) ->
- parse_Enumerations(Tokens,[],ExtensionDefault);
-parse_Enumerations([H|_T],_) ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,identifier]}}).
-
-parse_Enumerations(Tokens = [{identifier,_,_},{'(',_}|_Rest], Acc, ExtensionDefault) ->
- {NamedNumber,Rest2} = parse_NamedNumber(Tokens),
- case Rest2 of
- [{',',_}|Rest3] ->
- parse_Enumerations(Rest3,[NamedNumber|Acc], ExtensionDefault);
- _ when ExtensionDefault == 'IMPLIED'->
- {lists:reverse(['EXTENSIONMARK',NamedNumber|Acc]),Rest2};
+parse_Enumerations(Tokens0) ->
+ {Root,Tokens1} = parse_Enumeration(Tokens0),
+ case Tokens1 of
+ [{',',_},{'...',_},{',',_}|Tokens2] ->
+ {Ext,Tokens} = parse_Enumeration(Tokens2),
+ {Root++['EXTENSIONMARK'|Ext],Tokens};
+ [{',',_},{'...',_}|Tokens] ->
+ {Root++['EXTENSIONMARK'],Tokens};
_ ->
- {lists:reverse([NamedNumber|Acc]),Rest2}
- end;
-parse_Enumerations([{identifier,_,Id}|Rest], Acc, ExtensionDefault) ->
- case Rest of
- [{',',_}|Rest2] ->
- parse_Enumerations(Rest2,[Id|Acc], ExtensionDefault);
- _ when ExtensionDefault == 'IMPLIED' ->
- {lists:reverse(['EXTENSIONMARK', Id |Acc]),Rest};
- _ ->
- {lists:reverse([Id|Acc]),Rest}
- end;
-parse_Enumerations([{'...',_}|Rest], Acc, _ExtensionDefault) ->
- case Rest of
- [{',',_}|Rest2] ->
- parse_Enumerations(Rest2,['EXTENSIONMARK'|Acc],undefined);
- _ ->
- {lists:reverse(['EXTENSIONMARK'|Acc]),Rest}
+ case get(extensiondefault) of
+ 'IMPLIED' ->
+ {Root++['EXTENSIONMARK'],Tokens1};
+ _ ->
+ {Root,Tokens1}
+ end
+ end.
+
+parse_Enumeration(Tokens0) ->
+ {Item,Tokens} = parse_EnumerationItem(Tokens0),
+ parse_Enumeration_1(Tokens, [Item]).
+
+parse_Enumeration_1([{',',_}|Tokens1]=Tokens0, Acc) ->
+ try parse_EnumerationItem(Tokens1) of
+ {Item,Tokens} ->
+ parse_Enumeration_1(Tokens, [Item|Acc])
+ catch
+ throw:{asn1_error,_} ->
+ {lists:reverse(Acc),Tokens0}
end;
-parse_Enumerations([H|_T],_,_) ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,identifier]}}).
+parse_Enumeration_1(Tokens, Acc) ->
+ {lists:reverse(Acc),Tokens}.
+
+parse_EnumerationItem([#identifier{},{'(',_}|_]=Tokens) ->
+ parse_NamedNumber(Tokens);
+parse_EnumerationItem([#identifier{val=Id}|Tokens]) ->
+ {Id,Tokens};
+parse_EnumerationItem(Tokens) ->
+ parse_error(Tokens).
+
+%%%
+%%% End of parsing of ENUMERATED.
+%%%
parse_NamedNumberList(Tokens) ->
- parse_NamedNumberList(Tokens,[]).
+ parse_NamedNumberList(Tokens, []).
-parse_NamedNumberList(Tokens,Acc) ->
+parse_NamedNumberList(Tokens, Acc) ->
{NamedNum,Rest} = parse_NamedNumber(Tokens),
case Rest of
[{',',_}|Rest2] ->
parse_NamedNumberList(Rest2,[NamedNum|Acc]);
_ ->
- {lists:reverse([NamedNum|Acc]),Rest}
+ {lists:reverse(Acc, [NamedNum]),Rest}
end.
-parse_NamedNumber([{identifier,_,Name},{'(',_}|Rest]) ->
+parse_NamedNumber([#identifier{val=Name},{'(',_}|Rest]) ->
Flist = [fun parse_SignedNumber/1,
fun parse_DefinedValue/1],
- case (catch parse_or(Rest,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_} ->
- throw(AsnErr);
+ case parse_or(Rest, Flist) of
{NamedNum,[{')',_}|Rest2]} ->
{{'NamedNumber',Name,NamedNum},Rest2};
_ ->
- throw({asn1_error,{get_line(hd(Rest)),get(asn1_module),
- [got,get_token(hd(Rest)),expected,'NamedNumberList']}})
+ parse_error(Rest)
end;
parse_NamedNumber(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,identifier]}}).
+ parse_error(Tokens).
+parse_SignedNumber([{number,_,Value}|Rest]) ->
+ {Value,Rest};
+parse_SignedNumber(Tokens) ->
+ parse_error(Tokens).
parse_Tag([{'[',_}|Rest]) ->
{Class,Rest2} = parse_Class(Rest),
@@ -2767,12 +2003,8 @@ parse_Tag([{'[',_}|Rest]) ->
[{']',_}|Rest4] ->
{#tag{class=Class,number=ClassNumber},Rest4};
_ ->
- throw({asn1_error,{get_line(hd(Rest3)),get(asn1_module),
- [got,get_token(hd(Rest3)),expected,']']}})
- end;
-parse_Tag(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,'[']}}).
+ parse_error(Rest3)
+ end.
parse_Class([{'UNIVERSAL',_}|Rest]) ->
{'UNIVERSAL',Rest};
@@ -2791,15 +2023,7 @@ parse_Value(Tokens) ->
Flist = [fun parse_BuiltinValue/1,
fun parse_ValueFromObject/1,
fun parse_DefinedValue/1],
-
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_} ->
- throw(AsnErr);
- Result ->
- Result
- end.
+ parse_or(Tokens, Flist).
parse_BuiltinValue([{bstring,_,Bstr}|Rest]) ->
{{bstring,Bstr},Rest};
@@ -2812,18 +2036,11 @@ parse_BuiltinValue(Tokens = [{'{',_}|_Rest]) ->
fun parse_SequenceOfValue/1,
fun parse_SequenceValue/1,
fun parse_ObjectIdentifierValue/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_} ->
- throw(AsnErr);
- Result ->
- Result
- end;
-parse_BuiltinValue([{identifier,_,IdName},{':',_}|Rest]) ->
+ parse_or(Tokens, Flist);
+parse_BuiltinValue([#identifier{val=IdName},{':',_}|Rest]) ->
{Value,Rest2} = parse_Value(Rest),
{{'CHOICE',{IdName,Value}},Rest2};
-parse_BuiltinValue(Tokens=[{'NULL',_},{':',_}|_Rest]) ->
+parse_BuiltinValue([{'NULL',_},{':',_}|_]=Tokens) ->
parse_ObjectClassFieldValue(Tokens);
parse_BuiltinValue([{'NULL',_}|Rest]) ->
{'NULL',Rest};
@@ -2839,31 +2056,29 @@ parse_BuiltinValue([{cstring,_,Cstr}|Rest]) ->
{Cstr,Rest};
parse_BuiltinValue([{number,_,Num}|Rest]) ->
{Num,Rest};
-parse_BuiltinValue([{'-',_},{number,_,Num}|Rest]) ->
- {- Num,Rest};
parse_BuiltinValue(Tokens) ->
parse_ObjectClassFieldValue(Tokens).
-parse_DefinedValue(Tokens=[{identifier,_,_},{'{',_}|_Rest]) ->
- parse_ParameterizedValue(Tokens);
-%% Externalvaluereference
-parse_DefinedValue([{typereference,L1,Tname},{'.',_},{identifier,_,Idname}|Rest]) ->
+parse_DefinedValue(Tokens) ->
+ Flist = [fun parse_ParameterizedValue/1,
+ fun parse_DefinedValue2/1],
+ parse_or(Tokens, Flist).
+
+parse_DefinedValue2([{typereference,L1,Tname},
+ {'.',_},
+ #identifier{val=Idname}|Rest]) ->
{#'Externalvaluereference'{pos=L1,module=Tname,value=Idname},Rest};
%% valuereference
-parse_DefinedValue([Id = {identifier,_,_}|Rest]) ->
+parse_DefinedValue2([#identifier{}=Id|Rest]) ->
{identifier2Extvalueref(Id),Rest};
-%% ParameterizedValue
-parse_DefinedValue(Tokens) ->
- parse_ParameterizedValue(Tokens).
+parse_DefinedValue2(Tokens) ->
+ parse_error(Tokens).
parse_SequenceValue([{'{',_}|Tokens]) ->
- parse_SequenceValue(Tokens,[]);
-parse_SequenceValue(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,'{']}}).
+ parse_SequenceValue(Tokens, []).
-parse_SequenceValue([{identifier,Pos,IdName}|Rest],Acc) ->
+parse_SequenceValue([#identifier{pos=Pos,val=IdName}|Rest],Acc) ->
{Value,Rest2} = parse_Value(Rest),
SeqTag = #seqtag{pos=Pos,module=get(asn1_module),val=IdName},
case Rest2 of
@@ -2872,18 +2087,13 @@ parse_SequenceValue([{identifier,Pos,IdName}|Rest],Acc) ->
[{'}',_}|Rest3] ->
{lists:reverse(Acc, [{SeqTag,Value}]),Rest3};
_ ->
- throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module),
- [got,get_token(hd(Rest2)),expected,'}']}})
+ parse_error(Rest2)
end;
parse_SequenceValue(Tokens,_Acc) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,identifier]}}).
+ parse_error(Tokens).
parse_SequenceOfValue([{'{',_}|Tokens]) ->
- parse_SequenceOfValue(Tokens,[]);
-parse_SequenceOfValue(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,'{']}}).
+ parse_SequenceOfValue(Tokens, []).
parse_SequenceOfValue(Tokens,Acc) ->
{Value,Rest2} = parse_Value(Tokens),
@@ -2891,10 +2101,9 @@ parse_SequenceOfValue(Tokens,Acc) ->
[{',',_}|Rest3] ->
parse_SequenceOfValue(Rest3,[Value|Acc]);
[{'}',_}|Rest3] ->
- {lists:reverse([Value|Acc]),Rest3};
+ {lists:reverse(Acc, [Value]),Rest3};
_ ->
- throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module),
- [got,get_token(hd(Rest2)),expected,'}']}})
+ parse_error(Rest2)
end.
parse_ValueSetTypeAssignment([{typereference,L1,Name}|Rest]) ->
@@ -2904,49 +2113,31 @@ parse_ValueSetTypeAssignment([{typereference,L1,Name}|Rest]) ->
{ValueSet,Rest4} = parse_ValueSet(Rest3),
{#valuedef{pos=L1,name=Name,type=Type,value=ValueSet,
module=get(asn1_module)},Rest4};
- [H|_T] ->
- throw({asn1_error,{get_line(L1),get(asn1_module),
- [got,get_token(H),expected,'::=']}})
- end;
-parse_ValueSetTypeAssignment(Tokens) ->
- throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,
- typereference]}}).
+ _ ->
+ parse_error(Rest2)
+ end.
parse_ValueSet([{'{',_}|Rest]) ->
{Elems,Rest2} = parse_ElementSetSpecs(Rest),
case Rest2 of
[{'}',_}|Rest3] ->
{{valueset,Elems},Rest3};
- [H|_T] ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,'}']}})
+ _ ->
+ parse_error(Rest2)
end;
parse_ValueSet(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,'{']}}).
+ parse_error(Tokens).
-parse_ValueAssignment([{identifier,L1,IdName}|Rest]) ->
+parse_ValueAssignment([#identifier{pos=L1,val=IdName}|Rest]) ->
{Type,Rest2} = parse_Type(Rest),
case Rest2 of
[{'::=',_}|Rest3] ->
{Value,Rest4} = parse_Value(Rest3),
- case catch lookahead_assignment(Rest4) of
- ok ->
- {#valuedef{pos=L1,name=IdName,type=Type,value=Value,
- module=get(asn1_module)},Rest4};
- Error ->
- throw(Error)
-%% throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module),
-%% [got,get_token(hd(Rest2)),expected,'::=']}})
- end;
+ {#valuedef{pos=L1,name=IdName,type=Type,value=Value,
+ module=get(asn1_module)},Rest4};
_ ->
- throw({asn1_error,{get_line(hd(Rest2)),get(asn1_module),
- [got,get_token(hd(Rest2)),expected,'::=']}})
- end;
-parse_ValueAssignment(Tokens) ->
- throw({asn1_assignment_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,identifier]}}).
+ parse_error(Rest2)
+ end.
%% SizeConstraint
parse_SubtypeElements([{'SIZE',_}|Tokens]) ->
@@ -2966,8 +2157,7 @@ parse_SubtypeElements([{'WITH',_},{'COMPONENTS',_},{'{',_},{'...',_},{',',_}|Tok
[{'}',_}|Rest2] ->
{{'WITH COMPONENTS',{'PartialSpecification',Constraint}},Rest2};
_ ->
- throw({asn1_error,{get_line(hd(Rest)),get(asn1_module),
- [got,get_token(hd(Rest)),expected,'}']}})
+ parse_error(Rest)
end;
parse_SubtypeElements([{'WITH',_},{'COMPONENTS',_},{'{',_}|Tokens]) ->
{Constraint,Rest} = parse_TypeConstraints(Tokens),
@@ -2975,28 +2165,18 @@ parse_SubtypeElements([{'WITH',_},{'COMPONENTS',_},{'{',_}|Tokens]) ->
[{'}',_}|Rest2] ->
{{'WITH COMPONENTS',{'FullSpecification',Constraint}},Rest2};
_ ->
- throw({asn1_error,{get_line(hd(Rest)),get(asn1_module),
- [got,get_token(hd(Rest)),expected,'}']}})
+ parse_error(Rest)
end;
parse_SubtypeElements([{'PATTERN',_}|Tokens]) ->
{Value,Rest} = parse_Value(Tokens),
{{pattern,Value},Rest};
-%% SingleValue
-%% ContainedSubtype
-%% ValueRange
-%% TypeConstraint
-%% Moved fun parse_Value/1 and fun parse_Type/1 to parse_Elements
parse_SubtypeElements(Tokens) ->
Flist = [fun parse_ContainedSubtype/1,
fun parse_Value/1,
- fun([{'MIN',_}|T]) -> {'MIN',T} end,
+ fun parse_MIN/1,
fun parse_Type/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- {asn1_error,Reason} ->
- throw(Reason);
- Result = {Val,_} when is_record(Val,type) ->
+ case parse_or(Tokens, Flist) of
+ {#type{},_}=Result ->
Result;
{Lower,[{'..',_}|Rest]} ->
{Upper,Rest2} = parse_UpperEndpoint(Rest),
@@ -3014,10 +2194,7 @@ parse_ContainedSubtype([{'INCLUDES',_}|Rest]) ->
{Type,Rest2} = parse_Type(Rest),
{{'ContainedSubtype',Type},Rest2};
parse_ContainedSubtype(Tokens) ->
- throw({asn1_error,{get_line(hd(Tokens)),get(asn1_module),
- [got,get_token(hd(Tokens)),expected,'INCLUDES']}}).
-%%parse_ContainedSubtype(Tokens) -> %this option is moved to parse_SubtypeElements
-%% parse_Type(Tokens).
+ parse_error(Tokens).
parse_UpperEndpoint([{'<',_}|Rest]) ->
parse_UpperEndpoint(lt,Rest);
@@ -3025,33 +2202,38 @@ parse_UpperEndpoint(Tokens) ->
parse_UpperEndpoint(false,Tokens).
parse_UpperEndpoint(Lt,Tokens) ->
- Flist = [ fun([{'MAX',_}|T]) -> {'MAX',T} end,
- fun parse_Value/1],
- case (catch parse_or(Tokens,Flist)) of
- {'EXIT',Reason} ->
- exit(Reason);
- AsnErr = {asn1_error,_} ->
- throw(AsnErr);
- {Value,Rest2} when Lt == lt ->
+ Flist = [fun parse_MAX/1,
+ fun parse_Value/1],
+ case parse_or(Tokens, Flist) of
+ {Value,Rest2} when Lt =:= lt ->
{{lt,Value},Rest2};
{Value,Rest2} ->
{Value,Rest2}
end.
+parse_MIN([{'MIN',_}|T]) ->
+ {'MIN',T};
+parse_MIN(Tokens) ->
+ parse_error(Tokens).
+
+parse_MAX([{'MAX',_}|T]) ->
+ {'MAX',T};
+parse_MAX(Tokens) ->
+ parse_error(Tokens).
+
parse_TypeConstraints(Tokens) ->
- parse_TypeConstraints(Tokens,[]).
+ parse_TypeConstraints(Tokens, []).
-parse_TypeConstraints([{identifier,_,_}|Rest],Acc) ->
+parse_TypeConstraints([#identifier{}|Rest], Acc) ->
{ComponentConstraint,Rest2} = parse_ComponentConstraint(Rest),
case Rest2 of
[{',',_}|Rest3] ->
- parse_TypeConstraints(Rest3,[ComponentConstraint|Acc]);
+ parse_TypeConstraints(Rest3, [ComponentConstraint|Acc]);
_ ->
- {lists:reverse([ComponentConstraint|Acc]),Rest2}
+ {lists:reverse(Acc, [ComponentConstraint]),Rest2}
end;
-parse_TypeConstraints([H|_T],_) ->
- throw({asn1_error,{get_line(H),get(asn1_module),
- [got,get_token(H),expected,identifier]}}).
+parse_TypeConstraints(Tokens, _) ->
+ parse_error(Tokens).
parse_ComponentConstraint(Tokens = [{'(',_}|_Rest]) ->
{ValueConstraint,Rest2} = parse_Constraint(Tokens),
@@ -3071,145 +2253,36 @@ parse_PresenceConstraint(Tokens) ->
{asn1_empty,Tokens}.
-% merge_constraints({Rlist,ExtList}) -> % extensionmarker in constraint
-% {merge_constraints(Rlist,[],[]),
-% merge_constraints(ExtList,[],[])};
-
-%% An arg with a constraint with extension marker will look like
-%% [#constraint{c={Root,Ext}}|Rest]
-
merge_constraints(Clist) ->
merge_constraints(Clist, [], []).
-merge_constraints([Ch|Ct],Cacc, Eacc) ->
- NewEacc = case Ch#constraint.e of
- undefined -> Eacc;
- E -> [E|Eacc]
- end,
- merge_constraints(Ct,[fixup_constraint(Ch#constraint.c)|Cacc],NewEacc);
-
-merge_constraints([],Cacc,[]) ->
-%% lists:flatten(Cacc);
+merge_constraints([#constraint{c=C,e=E}|T], Cacc0, Eacc0) ->
+ Eacc = case E of
+ undefined -> Eacc0;
+ E -> [E|Eacc0]
+ end,
+ Cacc = [C|Cacc0],
+ merge_constraints(T, Cacc, Eacc);
+merge_constraints([], Cacc, []) ->
lists:reverse(Cacc);
-merge_constraints([],Cacc,Eacc) ->
-%% lists:flatten(Cacc) ++ [{'Errors',Eacc}].
- lists:reverse(Cacc) ++ [{'Errors',Eacc}].
-
-
-fixup_constraint(C) ->
- case C of
- {'SingleValue',SubType} when element(1,SubType) == 'ContainedSubtype' ->
- SubType;
- {'SingleValue',V} when is_list(V) ->
- C;
- %% [C,{'ValueRange',{lists:min(V),lists:max(V)}}];
- %% bug, turns wrong when an element in V is a reference to a defined value
- {'PermittedAlphabet',{'SingleValue',V}} when is_list(V) ->
- %%sort and remove duplicates
- V2 = {'SingleValue',
- ordsets:from_list(lists:flatten(V))},
- {'PermittedAlphabet',V2};
- {'PermittedAlphabet',{'SingleValue',V}} ->
- V2 = {'SingleValue',[V]},
- {'PermittedAlphabet',V2};
- {'SizeConstraint',Sc} ->
- {'SizeConstraint',fixup_size_constraint(Sc)};
-
- List when is_list(List) -> %% In This case maybe a union or intersection
- [fixup_constraint(Xc)||Xc <- List];
- Other ->
- Other
- end.
+merge_constraints([], Cacc, Eacc) ->
+ lists:reverse(Cacc) ++ [{element_set,{'Errors',Eacc},none}].
-fixup_size_constraint({'ValueRange',{Lb,Ub}}) ->
- {Lb,Ub};
-fixup_size_constraint({{'ValueRange',R},[]}) ->
- {R,[]};
-fixup_size_constraint({[],{'ValueRange',R}}) ->
- {[],R};
-fixup_size_constraint({{'ValueRange',R1},{'ValueRange',R2}}) ->
- {R1,R2};
-fixup_size_constraint({'SingleValue',[Sv]}) ->
- fixup_size_constraint({'SingleValue',Sv});
-fixup_size_constraint({'SingleValue',L}) when is_list(L) ->
- ordsets:from_list(L);
-fixup_size_constraint({'SingleValue',L}) ->
- {L,L};
-fixup_size_constraint({'SizeConstraint',C}) ->
- %% this is a second SIZE
- fixup_size_constraint(C);
-fixup_size_constraint({C1,C2}) ->
- %% this is with extension marks
- {turn2vr(fixup_size_constraint(C1)), extension_size(fixup_size_constraint(C2))};
-fixup_size_constraint(CList) when is_list(CList) ->
- [fixup_constraint(Xc)||Xc <- CList].
-
-turn2vr(L) when is_list(L) ->
- L2 =[X||X<-ordsets:from_list(L),is_integer(X)],
- case L2 of
- [H|_] ->
- {H,hd(lists:reverse(L2))};
- _ ->
- L
- end;
-turn2vr(VR) ->
- VR.
-extension_size({I,I}) ->
- [I];
-extension_size({I1,I2}) ->
- [I1,I2];
-extension_size(C) ->
- C.
-
-get_line({_,Pos,Token}) when is_integer(Pos),is_atom(Token) ->
+get_line({Token,Pos,_}) when is_integer(Pos), is_atom(Token) ->
Pos;
get_line({Token,Pos}) when is_integer(Pos),is_atom(Token) ->
- Pos;
-get_line(_) ->
- undefined.
-
-get_token({_,Pos,Token}) when is_integer(Pos),is_atom(Token) ->
- Token;
+ Pos.
+
+get_token({valuefieldreference,_,FieldName}) ->
+ list_to_atom([$&|atom_to_list(FieldName)]);
+get_token({typefieldreference,_,FieldName}) ->
+ list_to_atom([$&|atom_to_list(FieldName)]);
+get_token({Token,Pos,Value}) when is_integer(Pos), is_atom(Token) ->
+ Value;
get_token({'$end',Pos}) when is_integer(Pos) ->
- undefined;
+ 'END-OF-FILE';
get_token({Token,Pos}) when is_integer(Pos),is_atom(Token) ->
- Token;
-get_token(_) ->
- undefined.
-
-prioritize_error(ErrList) ->
- case lists:keymember(asn1_error,1,ErrList) of
- false -> % only asn1_assignment_error -> take the last
- lists:last(ErrList);
- true -> % contains errors from deeper in a Type
- NewErrList = [_Err={_,_}|_RestErr] =
- lists:filter(fun({asn1_error,_})->true;(_)->false end,
- ErrList),
- SplitErrs =
- lists:splitwith(fun({_,X})->
- case element(1,X) of
- Int when is_integer(Int) -> true;
- _ -> false
- end
- end,
- NewErrList),
- case SplitErrs of
- {[],UndefPosErrs} -> % if no error with Positon exists
- lists:last(UndefPosErrs);
- {IntPosErrs,_} ->
- IntPosReasons = lists:map(fun(X)->element(2,X) end,IntPosErrs),
- SortedReasons = lists:keysort(1,IntPosReasons),
- {asn1_error,lists:last(SortedReasons)}
- end
- end.
-
-%% most_prio_error([H={_,Reason}|T],Atom,Err) when is_atom(Atom) ->
-%% most_prio_error(T,element(1,Reason),H);
-%% most_prio_error([H={_,Reason}|T],Greatest,Err) ->
-%% case element(1,Reason) of
-%% Pos when is_integer(Pos),Pos>Greatest ->
-%% most_prio_error(
-
+ Token.
tref2Exttref(#typereference{pos=Pos,val=Name}) ->
#'Externaltypereference'{pos=Pos,
@@ -3226,19 +2299,5 @@ identifier2Extvalueref(#identifier{pos=Pos,val=Name}) ->
module=resolve_module(Name),
value=Name}.
-%% lookahead_assignment/1 checks that the next sequence of tokens
-%% in Token contain a valid assignment or the
-%% 'END' token. Otherwise an exception is thrown.
-lookahead_assignment([{'END',_}|_Rest]) ->
- ok;
-lookahead_assignment(Tokens) ->
- parse_Assignment(Tokens),
- ok.
-
-is_pre_defined_class('TYPE-IDENTIFIER') ->
- true;
-is_pre_defined_class('ABSTRACT-SYNTAX') ->
- true;
-is_pre_defined_class(_) ->
- false.
-
+parse_error(Tokens) ->
+ throw({asn1_error,{parse_error,Tokens}}).
diff --git a/lib/asn1/src/asn1ct_tok.erl b/lib/asn1/src/asn1ct_tok.erl
index 8687ed955c..d51fea6402 100644
--- a/lib/asn1/src/asn1ct_tok.erl
+++ b/lib/asn1/src/asn1ct_tok.erl
@@ -21,191 +21,177 @@
%% Tokenize ASN.1 code (input to parser generated with yecc)
--export([get_name/2,tokenise/4, file/1]).
+-export([file/1,format_error/1]).
-
-file(File) ->
- case file:open(File, [read]) of
+file(File0) ->
+ case file:open(File0, [read]) of
{error, Reason} ->
- {error,{File,file:format_error(Reason)}};
+ {error,{File0,file:format_error(Reason)}};
{ok,Stream} ->
- process(Stream,0,[])
+ try
+ process(Stream, 1, [])
+ catch
+ throw:{error,Line,Reason} ->
+ File = filename:basename(File0),
+ Error = {structured_error,{File,Line},?MODULE,Reason},
+ {error,[Error]}
+ end
end.
-process(Stream,Lno,R) ->
- process(io:get_line(Stream, ''), Stream,Lno+1,R).
+process(Stream, Lno, R) ->
+ process(io:get_line(Stream, ''), Stream, Lno, R).
-process(eof, Stream,Lno,R) ->
+process(eof, Stream, Lno, Acc) ->
ok = file:close(Stream),
- lists:flatten(lists:reverse([{'$end',Lno}|R]));
-
-
-process(L, Stream,Lno,R) when is_list(L) ->
- %%io:format('read:~s',[L]),
- case catch tokenise(Stream,L,Lno,[]) of
- {'ERR',Reason} ->
- io:format("Tokeniser error on line: ~w ~w~n",[Lno,Reason]),
- exit(0);
- {NewLno,T} ->
- %%io:format('toks:~w~n',[T]),
- process(Stream,NewLno,[T|R])
- end.
-
-tokenise(Stream,[H|T],Lno,R) when $a =< H , H =< $z ->
- {X, T1} = get_name(T, [H]),
- tokenise(Stream,T1,Lno,[{identifier,Lno, list_to_atom(X)}|R]);
-
-tokenise(Stream,[$&,H|T],Lno,R) when $A =< H , H =< $Z ->
- {Y, T1} = get_name(T, [H]),
- X = list_to_atom(Y),
- tokenise(Stream,T1,Lno,[{typefieldreference, Lno, X} | R]);
-
-tokenise(Stream,[$&,H|T],Lno,R) when $a =< H , H =< $z ->
- {Y, T1} = get_name(T, [H]),
- X = list_to_atom(Y),
- tokenise(Stream,T1,Lno,[{valuefieldreference, Lno, X} | R]);
-
-tokenise(Stream,[H|T],Lno,R) when $A =< H , H =< $Z ->
- {Y, T1} = get_name(T, [H]),
- X = list_to_atom(Y),
- case reserved_word(X) of
- true ->
- tokenise(Stream,T1,Lno,[{X,Lno}|R]);
- false ->
- tokenise(Stream,T1,Lno,[{typereference,Lno,X}|R]);
- rstrtype ->
- tokenise(Stream,T1,Lno,[{restrictedcharacterstringtype,Lno,X}|R])
- end;
-
-tokenise(Stream,[$-,H|T],Lno,R) when $0 =< H , H =< $9 ->
- {X, T1} = get_number(T, [H]),
- tokenise(Stream,T1,Lno,[{number,Lno,-1 * list_to_integer(X)}|R]);
+ lists:reverse([{'$end',Lno}|Acc]);
+process(L, Stream, Lno0, Acc) when is_list(L) ->
+ try tokenise(Stream, L, Lno0, []) of
+ {Lno,[]} ->
+ process(Stream, Lno, Acc);
+ {Lno,Ts} ->
+ process(Stream, Lno, Ts++Acc)
+ catch
+ throw:{error,Reason} ->
+ throw({error,Lno0,Reason})
+ end.
-tokenise(Stream,[H|T],Lno,R) when $0 =< H , H =< $9 ->
+format_error(eof_in_comment) ->
+ "premature end of file in multi-line comment";
+format_error(eol_in_token) ->
+ "end of line in token";
+format_error({invalid_binary_number,Str}) ->
+ io_lib:format("invalid binary number: '~s'", [Str]);
+format_error({invalid_hex_number,Str}) ->
+ io_lib:format("invalid hex number: '~s'", [Str]);
+format_error(Other) ->
+ io_lib:format("~p", [Other]).
+
+tokenise(Stream, [$&,H|T], Lno, R) when $A =< H , H =< $Z ->
+ {X,T1} = get_name(T, [H]),
+ tokenise(Stream, T1, Lno, [{typefieldreference,Lno,X}|R]);
+tokenise(Stream, [$&,H|T], Lno, R) when $a =< H , H =< $z ->
+ {X,T1} = get_name(T, [H]),
+ tokenise(Stream, T1, Lno, [{valuefieldreference,Lno,X}|R]);
+
+tokenise(Stream, "--"++T, Lno, R) ->
+ tokenise(Stream, skip_comment(T), Lno, R);
+
+tokenise(Stream, [$-,H|T], Lno, R) when $0 =< H , H =< $9 ->
{X, T1} = get_number(T, [H]),
- tokenise(Stream,T1,Lno,[{number,Lno,list_to_integer(X)}|R]);
-
-tokenise(Stream,[$-,$-|T],Lno,R) ->
- tokenise(Stream,skip_comment(T),Lno,R);
+ tokenise(Stream, T1, Lno, [{number,Lno,-list_to_integer(X)}|R]);
-tokenise(Stream,[$/,$*|T],Lno,R) ->
- {NewLno,T1} = skip_multiline_comment(Stream,T,Lno,0),
- tokenise(Stream,T1,NewLno,R);
+tokenise(Stream, "/*"++T, Lno0, R) ->
+ {Lno,T1} = skip_multiline_comment(Stream, T, Lno0, 0),
+ tokenise(Stream, T1, Lno, R);
-tokenise(Stream,[$:,$:,$=|T],Lno,R) ->
- tokenise(Stream,T,Lno,[{'::=',Lno}|R]);
-
-tokenise(Stream,[$'|T],Lno,R) ->
- case catch collect_quoted(T,Lno,[]) of
- {'ERR',_} ->
- throw({'ERR','bad_quote'});
- {Thing, T1} ->
- tokenise(Stream,T1,Lno,[Thing|R])
- end;
+tokenise(Stream, "::="++T, Lno, R) ->
+ tokenise(Stream, T, Lno, [{'::=',Lno}|R]);
+tokenise(Stream, ":"++T, Lno, R) ->
+ tokenise(Stream, T, Lno, [{':',Lno}|R]);
+tokenise(Stream, "'"++T0, Lno, R) ->
+ {Thing, T1} = collect_quoted(T0, Lno, []),
+ tokenise(Stream, T1, Lno, [Thing|R]);
tokenise(Stream,[$"|T],Lno,R) ->
{Str,T1} = collect_string(T,Lno),
tokenise(Stream,T1,Lno,[Str|R]);
-tokenise(Stream,[${|T],Lno,R) ->
- tokenise(Stream,T,Lno,[{'{',Lno}|R]);
-
-tokenise(Stream,[$}|T],Lno,R) ->
- tokenise(Stream,T,Lno,[{'}',Lno}|R]);
-
-%% tokenise(Stream,[$],$]|T],Lno,R) ->
-%% tokenise(Stream,T,Lno,[{']]',Lno}|R]);
+tokenise(Stream, "{"++T, Lno, R) ->
+ tokenise(Stream, T, Lno, [{'{',Lno}|R]);
+tokenise(Stream, "}"++T, Lno, R) ->
+ tokenise(Stream, T, Lno, [{'}',Lno}|R]);
%% Even though x.680 specify '[[' and ']]' as lexical items
-%% it does not work to have them as such since the single [ and ] can
-%% be used beside each other in the SYNTAX OF in x.681
-%% the solution chosen here , i.e. to have them as separate lexical items
+%% it does not work to have them as such since the single '[' and ']' can
+%% be used beside each other in 'WITH SYNTAX' in x.681.
+%% The solution chosen here, i.e. to have them as separate lexical items
%% will not detect the cases where there is white space between them
-%% which would be an error in the use in ExtensionAdditionGroups
-
-%% tokenise(Stream,[$[,$[|T],Lno,R) ->
-%% tokenise(Stream,T,Lno,[{'[[',Lno}|R]);
-
-tokenise(Stream,[$]|T],Lno,R) ->
- tokenise(Stream,T,Lno,[{']',Lno}|R]);
-
-tokenise(Stream,[$[|T],Lno,R) ->
- tokenise(Stream,T,Lno,[{'[',Lno}|R]);
+%% which would be an error in the use in ExtensionAdditionGroups.
-tokenise(Stream,[$,|T],Lno,R) ->
- tokenise(Stream,T,Lno,[{',',Lno}|R]);
+tokenise(Stream, "]"++T, Lno, R) ->
+ tokenise(Stream, T, Lno, [{']',Lno}|R]);
+tokenise(Stream, "["++T,Lno,R) ->
+ tokenise(Stream, T, Lno, [{'[',Lno}|R]);
-tokenise(Stream,[$(|T],Lno,R) ->
- tokenise(Stream,T,Lno,[{'(',Lno}|R]);
-tokenise(Stream,[$)|T],Lno,R) ->
- tokenise(Stream,T,Lno,[{')',Lno}|R]);
+tokenise(Stream, ","++T,Lno,R) ->
+ tokenise(Stream, T, Lno, [{',',Lno}|R]);
-tokenise(Stream,[$.,$.,$.|T],Lno,R) ->
- tokenise(Stream,T,Lno,[{'...',Lno}|R]);
+tokenise(Stream, "("++T, Lno, R) ->
+ tokenise(Stream, T, Lno, [{'(',Lno}|R]);
+tokenise(Stream, ")"++T, Lno, R) ->
+ tokenise(Stream, T, Lno, [{')',Lno}|R]);
-tokenise(Stream,[$.,$.|T],Lno,R) ->
- tokenise(Stream,T,Lno,[{'..',Lno}|R]);
+tokenise(Stream, "..."++T,Lno,R) ->
+ tokenise(Stream, T, Lno, [{'...',Lno}|R]);
+tokenise(Stream, ".."++T, Lno, R) ->
+ tokenise(Stream, T, Lno, [{'..',Lno}|R]);
+tokenise(Stream, "."++T, Lno, R) ->
+ tokenise(Stream, T, Lno, [{'.',Lno}|R]);
-tokenise(Stream,[$.|T],Lno,R) ->
- tokenise(Stream,T,Lno,[{'.',Lno}|R]);
-tokenise(Stream,[$^|T],Lno,R) ->
- tokenise(Stream,T,Lno,[{'^',Lno}|R]);
-tokenise(Stream,[$!|T],Lno,R) ->
- tokenise(Stream,T,Lno,[{'!',Lno}|R]);
-tokenise(Stream,[$||T],Lno,R) ->
- tokenise(Stream,T,Lno,[{'|',Lno}|R]);
+tokenise(Stream, "|"++T, Lno, R) ->
+ tokenise(Stream, T, Lno, [{'|',Lno}|R]);
-tokenise(Stream,[H|T],Lno,R) ->
- case white_space(H) of
+tokenise(Stream, [H|T], Lno, R) when $A =< H , H =< $Z ->
+ {X,T1} = get_name(T, [H]),
+ case reserved_word(X) of
true ->
- tokenise(Stream,T,Lno,R);
+ tokenise(Stream, T1, Lno, [{X,Lno}|R]);
false ->
- tokenise(Stream,T,Lno,[{list_to_atom([H]),Lno}|R])
+ tokenise(Stream, T1, Lno, [{typereference,Lno,X}|R]);
+ rstrtype ->
+ tokenise(Stream, T1, Lno, [{restrictedcharacterstringtype,Lno,X}|R])
end;
-tokenise(_Stream,[],Lno,R) ->
- {Lno,lists:reverse(R)}.
+tokenise(Stream, [H|T], Lno, R) when $a =< H , H =< $z ->
+ {X, T1} = get_name(T, [H]),
+ tokenise(Stream, T1, Lno, [{identifier,Lno,X}|R]);
-collect_string(L,Lno) ->
- collect_string(L,Lno,[]).
+tokenise(Stream, [H|T], Lno, R) when $0 =< H , H =< $9 ->
+ {X, T1} = get_number(T, [H]),
+ tokenise(Stream, T1, Lno, [{number,Lno,list_to_integer(X)}|R]);
-collect_string([],_,_) ->
- throw({'ERR','bad_quote found eof'});
+tokenise(Stream, [H|T], Lno, R) when H =< $\s ->
+ tokenise(Stream, T, Lno, R);
-collect_string([H|T],Lno,Str) ->
- case H of
- $" ->
- {{cstring,1,lists:reverse(Str)},T};
- Ch ->
- collect_string(T,Lno,[Ch|Str])
- end.
-
+tokenise(Stream, [H|T], Lno, R) ->
+ tokenise(Stream, T, Lno, [{list_to_atom([H]),Lno}|R]);
+tokenise(_Stream, [], Lno, R) ->
+ {Lno+1,R}.
-% <name> is letters digits hyphens
-% hypen is not the last character. Hypen hyphen is NOT allowed
-%
-% <identifier> ::= <lowercase> <name>
+collect_string(L, Lno) ->
+ collect_string(L, Lno, []).
-get_name([$-,Char|T], L) ->
+collect_string([$"|T], _Lno, Str) ->
+ {{cstring,1,lists:reverse(Str)},T};
+collect_string([H|T], Lno, Str) ->
+ collect_string(T, Lno, [H|Str]);
+collect_string([], _, _) ->
+ throw({error,missing_quote_at_eof}).
+
+%% <name> is letters digits hyphens.
+%% Hypen is not the last character. Hypen hyphen is NOT allowed.
+%%
+%% <identifier> ::= <lowercase> <name>
+
+get_name([$-,Char|T]=T0, Acc) ->
case isalnum(Char) of
true ->
- get_name(T,[Char,$-|L]);
+ get_name(T, [Char,$-|Acc]);
false ->
- {lists:reverse(L),[$-,Char|T]}
+ {list_to_atom(lists:reverse(Acc)),T0}
end;
-get_name([$-|T], L) ->
- {lists:reverse(L),[$-|T]};
-get_name([Char|T], L) ->
+get_name([$-|_]=T, Acc) ->
+ {list_to_atom(lists:reverse(Acc)),T};
+get_name([Char|T]=T0, Acc) ->
case isalnum(Char) of
true ->
- get_name(T,[Char|L]);
+ get_name(T, [Char|Acc]);
false ->
- {lists:reverse(L),[Char|T]}
+ {list_to_atom(lists:reverse(Acc)),T0}
end;
-get_name([], L) ->
- {lists:reverse(L), []}.
-
+get_name([], Acc) ->
+ {list_to_atom(lists:reverse(Acc)),[]}.
isalnum(H) when $A =< H , H =< $Z ->
true;
@@ -221,67 +207,54 @@ isdigit(H) when $0 =< H , H =< $9 ->
isdigit(_) ->
false.
-white_space(9) -> true;
-white_space(10) -> true;
-white_space(13) -> true;
-white_space(32) -> true;
-white_space(_) -> false.
-
-
-get_number([H|T], L) ->
+get_number([H|T]=T0, L) ->
case isdigit(H) of
true ->
get_number(T, [H|L]);
false ->
- {lists:reverse(L), [H|T]}
+ {lists:reverse(L), T0}
end;
get_number([], L) ->
{lists:reverse(L), []}.
-skip_comment([]) ->
- [];
-skip_comment([$-,$-|T]) ->
- T;
-skip_comment([_|T]) ->
- skip_comment(T).
-
+skip_comment([]) -> [];
+skip_comment("--"++T) -> T;
+skip_comment([_|T]) -> skip_comment(T).
-skip_multiline_comment(Stream,[],Lno,Level) ->
- case io:get_line(Stream,'') of
+skip_multiline_comment(Stream, [], Lno, Level) ->
+ case io:get_line(Stream, '') of
eof ->
- io:format("Tokeniser error on line: ~w~n"
- "premature end of multiline comment~n",[Lno]),
- exit(0);
+ throw({error,eof_in_comment});
Line ->
- skip_multiline_comment(Stream,Line,Lno+1,Level)
+ skip_multiline_comment(Stream, Line, Lno+1, Level)
end;
-skip_multiline_comment(_Stream,[$*,$/|T],Lno,0) ->
+skip_multiline_comment(_Stream, "*/"++T, Lno, 0) ->
{Lno,T};
-skip_multiline_comment(Stream,[$*,$/|T],Lno,Level) ->
- skip_multiline_comment(Stream,T,Lno,Level - 1);
-skip_multiline_comment(Stream,[$/,$*|T],Lno,Level) ->
- skip_multiline_comment(Stream,T,Lno,Level + 1);
-skip_multiline_comment(Stream,[_|T],Lno,Level) ->
- skip_multiline_comment(Stream,T,Lno,Level).
-
-collect_quoted([$',$B|T],Lno, L) ->
+skip_multiline_comment(Stream, "*/"++T, Lno, Level) ->
+ skip_multiline_comment(Stream, T, Lno, Level - 1);
+skip_multiline_comment(Stream, "/*"++T, Lno, Level) ->
+ skip_multiline_comment(Stream, T, Lno, Level + 1);
+skip_multiline_comment(Stream, [_|T], Lno, Level) ->
+ skip_multiline_comment(Stream, T, Lno, Level).
+
+collect_quoted("'B"++T, Lno, L) ->
case check_bin(L) of
true ->
- {{bstring,Lno, lists:reverse(L)}, T};
+ {{bstring,Lno,lists:reverse(L)}, T};
false ->
- throw({'ERR',{invalid_binary_number, lists:reverse(L)}})
+ throw({error,{invalid_binary_number,lists:reverse(L)}})
end;
-collect_quoted([$',$H|T],Lno, L) ->
+collect_quoted("'H"++T, Lno, L) ->
case check_hex(L) of
true ->
- {{hstring,Lno, lists:reverse(L)}, T};
+ {{hstring,Lno,lists:reverse(L)}, T};
false ->
- throw({'ERR',{invalid_binary_number, lists:reverse(L)}})
+ throw({error,{invalid_hex_number,lists:reverse(L)}})
end;
collect_quoted([H|T], Lno, L) ->
collect_quoted(T, Lno,[H|L]);
collect_quoted([], _, _) -> % This should be allowed FIX later
- throw({'ERR',{eol_in_token}}).
+ throw({error,eol_in_token}).
check_bin([$0|T]) ->
check_bin(T);
@@ -351,7 +324,6 @@ reserved_word('INCLUDES') -> true;
reserved_word('INSTANCE') -> true;
reserved_word('INTEGER') -> true;
reserved_word('INTERSECTION') -> true;
-reserved_word('ISO646String') -> rstrtype;
reserved_word('MAX') -> true;
reserved_word('MIN') -> true;
reserved_word('MINUS-INFINITY') -> true;
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-10 00:08:59 +0000