Merge pull request #311 from maxime-esa/CHOICES_ISVALID

Choices isvalid

ADA_RTL2/src/adaasn1rtl-encoding-acn.adb

@@ -1345,6 +1345,59 @@ is
       BoolVal := not BoolVal;
    end Acn_Dec_Boolean_false_pattern;
 
+   procedure Acn_Enc_Boolean_true_false_pattern
+     (bs : in out Bitstream; BoolVal : Asn1Boolean; true_pattern : BitArray;
+      false_pattern : BitArray)
+   is
+   begin
+      for I in Integer range true_pattern'Range loop
+         pragma Loop_Invariant
+           (bs.Current_Bit_Pos = bs.Current_Bit_Pos'Loop_Entry +
+                   (I - true_pattern'First));
+         pragma Loop_Invariant
+           (bs.Current_Bit_Pos = bs.Current_Bit_Pos'Loop_Entry +
+                   (I - false_pattern'First));
+         BitStream_AppendBit
+           (bs, (if BoolVal then true_pattern (I) else false_pattern (I)));
+      end loop;
+   end Acn_Enc_Boolean_true_false_pattern;
+
+   procedure Acn_Dec_Boolean_true_false_pattern
+     (bs     : in out Bitstream; BoolVal : out Asn1Boolean;
+      true_pattern : BitArray;
+      false_pattern : BitArray;
+      Result :    out ASN1_RESULT)
+   is
+      bit_val : BIT;
+      true_value : Asn1Boolean := True;
+      false_value : Asn1Boolean := True;
+
+   begin
+      for I in Integer range true_pattern'Range loop
+         pragma Loop_Invariant
+           (bs.Current_Bit_Pos = bs.Current_Bit_Pos'Loop_Entry +
+                    (I - true_pattern'First));
+         pragma Loop_Invariant
+           (bs.Current_Bit_Pos = bs.Current_Bit_Pos'Loop_Entry +
+                    (I - false_pattern'First));
+         BitStream_ReadBit (bs, bit_val, Result.Success);
+         true_value := Result.Success and true_value and
+            bit_val = true_pattern (I);
+         false_value := Result.Success and false_value and
+            bit_val = false_pattern (I);
+      end loop;
+      BoolVal := (
+                   if true_value and not false_value then True
+                elsif false_value and not true_value then False
+                else False);
+
+      Result :=
+          ASN1_RESULT'(Success =>
+            (true_value and not false_value) or
+            (false_value and not true_value),
+                ErrorCode => 0);
+   end Acn_Dec_Boolean_true_false_pattern;
+
    procedure Acn_Enc_NullType_pattern
      (bs : in out Bitstream; encVal : Asn1NullType; pattern : BitArray)
    is

ADA_RTL2/src/adaasn1rtl-encoding-acn.ads

@@ -811,6 +811,40 @@ is
       bs.Current_Bit_Pos =
         bs'Old.Current_Bit_Pos + (pattern'Last - pattern'First + 1);
 
+   procedure Acn_Enc_Boolean_true_false_pattern
+     (bs : in out Bitstream; BoolVal : Asn1Boolean; true_pattern :
+      BitArray; false_pattern : BitArray) with
+      Depends => (bs => (bs, BoolVal, true_pattern, false_pattern)),
+      Pre     => true_pattern'Last >= true_pattern'First
+      and then true_pattern'First = false_pattern'First
+      and then true_pattern'Last = false_pattern'Last
+      and then true_pattern'Last - true_pattern'First < Natural'Last
+      and then bs.Current_Bit_Pos <
+        Natural'Last - (true_pattern'Last - true_pattern'First + 1)
+      and then bs.Size_In_Bytes < Positive'Last / 8
+      and then bs.Current_Bit_Pos <=
+        bs.Size_In_Bytes * 8 - (true_pattern'Last - true_pattern'First + 1),
+      Post => bs.Current_Bit_Pos =
+       bs'Old.Current_Bit_Pos + (true_pattern'Last - true_pattern'First + 1);
+
+   procedure Acn_Dec_Boolean_true_false_pattern
+     (bs     : in out Bitstream; BoolVal : out Asn1Boolean;
+      true_pattern : BitArray;
+      false_pattern : BitArray;
+      Result :    out ASN1_RESULT) with
+      Pre => true_pattern'Last >= true_pattern'First
+      and then true_pattern'First = false_pattern'First
+      and then true_pattern'Last = false_pattern'Last
+      and then true_pattern'Last - true_pattern'First < Natural'Last
+      and then bs.Current_Bit_Pos <
+        Natural'Last - (true_pattern'Last - true_pattern'First + 1)
+      and then bs.Size_In_Bytes < Positive'Last / 8
+      and then bs.Current_Bit_Pos <=
+        bs.Size_In_Bytes * 8 - (true_pattern'Last - true_pattern'First + 1),
+      Post =>
+      bs.Current_Bit_Pos =
+        bs'Old.Current_Bit_Pos + (true_pattern'Last - true_pattern'First + 1);
+
    procedure Acn_Enc_NullType_pattern
      (bs : in out Bitstream; encVal : Asn1NullType; pattern : BitArray) with
       Pre => pattern'Last >= pattern'First

BackendAst/DAstACN.fs

@@ -733,26 +733,40 @@ let createBooleanFunction (r:Asn1AcnAst.AstRoot) (lm:LanguageMacros) (codec:Comm
     let funcBody (errCode:ErrorCode) (acnArgs: (AcnGenericTypes.RelativePath*AcnGenericTypes.AcnParameter) list) (nestingScope: NestingScope) (p:CallerScope) =
         let Boolean         = lm.uper.Boolean
         let acnBoolean      = lm.acn.Boolean
-        let funcBodyContent, resultExpr, typeEncodingKind =
+        let BooleanTrueFalse = lm.acn.BooleanTrueFalse
+
+        let funcBodyContent, resultExpr=
+            let pvalue, ptr, resultExpr =
+                match codec, lm.lg.decodingKind with
+                | Decode, Copy ->
+                    let resExpr = p.arg.asIdentifier
+                    resExpr, resExpr, Some resExpr
+                | _ -> lm.lg.getValue p.arg, lm.lg.getPointer p.arg, None
             match o.acnProperties.encodingPattern with
             | None ->
                 let pp, resultExpr = adaptArgument lm codec p
-                Boolean pp errCode.errCodeName codec, resultExpr, AcnBooleanEncodingType None
-            | Some pattern  ->
-                let pvalue, ptr, resultExpr =
-                    match codec, lm.lg.decodingKind with
-                    | Decode, Copy ->
-                        let resExpr = p.arg.asIdentifier
-                        resExpr, resExpr, Some resExpr
-                    | _ -> lm.lg.getValue p.arg, lm.lg.getPointer p.arg, None
-                let arrBits = pattern.bitVal.Value.ToCharArray() |> Seq.mapi(fun i x -> ((i+1).ToString()) + "=>" + if x='0' then "0" else "1") |> Seq.toList
-                let arrBytes = bitStringValueToByteArray pattern.bitVal
-                let arrTrueValueAsByteArray = arrBytes |> Array.map (~~~)
-                let arrFalseValueAsByteArray = arrBytes
-                let nSize = pattern.bitVal.Value.Length
-                acnBoolean pvalue ptr pattern.isTrue (BigInteger nSize) arrTrueValueAsByteArray arrFalseValueAsByteArray arrBits errCode.errCodeName codec, resultExpr, AcnBooleanEncodingType (Some pattern)
-
-        {AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some typeEncodingKind}
+                Boolean pp errCode.errCodeName codec, resultExpr
+            | Some (TrueValueEncoding pattern)  ->
+                let arrBits = pattern.Value.ToCharArray() |> Seq.mapi(fun i x -> ((i+1).ToString()) + "=>" + if x='0' then "0" else "1") |> Seq.toList
+                let arrTrueValueAsByteArray = bitStringValueToByteArray pattern
+                let arrFalseValueAsByteArray = arrTrueValueAsByteArray |> Array.map (~~~)
+                let nSize = pattern.Value.Length
+                acnBoolean pvalue ptr true (BigInteger nSize) arrTrueValueAsByteArray arrFalseValueAsByteArray arrBits errCode.errCodeName codec, resultExpr
+            | Some (FalseValueEncoding pattern) ->
+                let arrBits = pattern.Value.ToCharArray() |> Seq.mapi(fun i x -> ((i+1).ToString()) + "=>" + if x='0' then "0" else "1") |> Seq.toList
+                let arrFalseValueAsByteArray = bitStringValueToByteArray pattern
+                let arrTrueValueAsByteArray = arrFalseValueAsByteArray |> Array.map (~~~)
+                let nSize = pattern.Value.Length
+                acnBoolean pvalue ptr false (BigInteger nSize) arrTrueValueAsByteArray arrFalseValueAsByteArray arrBits errCode.errCodeName codec, resultExpr
+            | Some (TrueFalseValueEncoding(trPattern, fvPatten)) ->
+                let arrTrueBits = trPattern.Value.ToCharArray() |> Seq.mapi(fun i x -> ((i+1).ToString()) + "=>" + if x='0' then "0" else "1") |> Seq.toList
+                let arrFalseBits = fvPatten.Value.ToCharArray() |> Seq.mapi(fun i x -> ((i+1).ToString()) + "=>" + if x='0' then "0" else "1") |> Seq.toList
+                let arrTrueValueAsByteArray = bitStringValueToByteArray trPattern
+                let arrFalseValueAsByteArray = bitStringValueToByteArray fvPatten
+                let nSize = trPattern.Value.Length
+                BooleanTrueFalse pvalue ptr (BigInteger nSize) arrTrueValueAsByteArray arrFalseValueAsByteArray arrTrueBits arrFalseBits errCode.errCodeName codec, resultExpr
+
+        {AcnFuncBodyResult.funcBody = funcBodyContent; errCodes = [errCode]; localVariables = []; bValIsUnReferenced= false; bBsIsUnReferenced=false; resultExpr=resultExpr; typeEncodingKind = Some (AcnBooleanEncodingType o.acnProperties.encodingPattern)}
     let soSparkAnnotations = Some(sparkAnnotations lm (typeDefinition.longTypedefName2 lm.lg.hasModules) codec)
     let icdFnc fieldName sPresent comments =
         [{IcdRow.fieldName = fieldName; comments = comments; sPresent=sPresent;sType=(IcdPlainType (getASN1Name t)); sConstraint=None; minLengthInBits = o.acnMinSizeInBits ;maxLengthInBits=o.acnMaxSizeInBits;sUnits=t.unitsOfMeasure; rowType = IcdRowType.FieldRow; idxOffset = None}]

BackendAst/DastValidate2.fs

@@ -694,18 +694,18 @@ let createTimeTypeFunction (r:Asn1AcnAst.AstRoot) (l:LanguageMacros) (t:Asn1AcnA
 let createEfficientEnumValidation (r:Asn1AcnAst.AstRoot) (l:LanguageMacros) (o:Asn1AcnAst.Enumerated)   (us:State)  =
     let getEnumIndexByName = l.isvalid.GetEnumIndexByName
     let td = (l.lg.getEnumTypeDefinition o.typeDef)
-    let bSorted = 
+    let bSorted =
         let sortedItems = o.validItems |> List.map(fun x -> x.definitionValue) |> List.sort
         let items = o.validItems |> List.map(fun x -> x.definitionValue)
         sortedItems = items
-    let optimizedValidation (p:CallerScope) = 
+    let optimizedValidation (p:CallerScope) =
         let ret = getEnumIndexByName td.values_array td.values_array_count (l.lg.getValue p.arg) bSorted
         VCBExpression (ret)
     [optimizedValidation], us
 
 
 let createEnumeratedFunction (r:Asn1AcnAst.AstRoot) (l:LanguageMacros) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Enumerated) (typeDefinition:TypeDefinitionOrReference)  (us:State)  =
-    let fncs, ns = 
+    let fncs, ns =
         match r.args.isEnumEfficientEnabled o.items.Length with
         | false -> o.cons |> Asn1Fold.foldMap (fun us c -> enumeratedConstraint2ValidationCodeBlock  l  o typeDefinition c us) us
         | true  -> createEfficientEnumValidation r l o us
@@ -847,11 +847,23 @@ let createSequenceFunction (r:Asn1AcnAst.AstRoot)  (l:LanguageMacros) (t:Asn1Acn
 let createChoiceFunction (r:Asn1AcnAst.AstRoot)  (l:LanguageMacros) (t:Asn1AcnAst.Asn1Type) (o:Asn1AcnAst.Choice) (typeDefinition:TypeDefinitionOrReference) (defOrRef:TypeDefinitionOrReference) (children:ChChildInfo list) (baseTypeValFunc : IsValidFunction option) (us:State)  =
     let choice_OptionalChild              = l.isvalid.Choice_OptionalChild
     let callBaseTypeFunc                  = l.isvalid.call_base_type_func
+    let choice_child                      = l.isvalid.choice_child
+    let choice_check_children             = l.isvalid.choice
+    let always_true_statement             = l.isvalid.always_true_statement
+    let always_false_statement            = l.isvalid.always_false_statement
+
+
     let handleChild (child:ChChildInfo) (us:State) =
         let c_name = l.lg.getAsn1ChChildBackendName child
         let presentWhenName = l.lg.presentWhenName (Some defOrRef) child
         match child.chType.isValidFunction with
-        | None                      -> None, us
+        | None                      ->
+            let childFnc =
+                let newFunc =
+                    (fun (p:CallerScope) ->
+                        ValidationStatement (choice_child presentWhenName (always_true_statement()) false c_name, []))
+                newFunc
+            Some(IsValidEmbedded {|isValidStatement = childFnc; localVars = []; alphaFuncs = []; childErrCodes = [] |}), us
         | Some (isValidFunction)    ->
             let func =
                 (*alternative's is validation statement. If the alternative has a separate function then make a call otherwise embed the code*)
@@ -870,9 +882,12 @@ let createChoiceFunction (r:Asn1AcnAst.AstRoot)  (l:LanguageMacros) (t:Asn1AcnAs
                             | Scala -> child._scala_name
                             | _ -> ""
                         match func p with
-                        | ValidationStatementTrue   (st,lv)  -> ValidationStatementTrue (choice_OptionalChild (p.arg.joined l.lg) localTmpVarName (l.lg.getAccess p.arg) presentWhenName st, lv)
-                        | ValidationStatementFalse  (st,lv)  -> ValidationStatement (choice_OptionalChild (p.arg.joined l.lg) localTmpVarName (l.lg.getAccess p.arg) presentWhenName st, lv)
-                        | ValidationStatement       (st,lv)  -> ValidationStatement (choice_OptionalChild (p.arg.joined l.lg) localTmpVarName (l.lg.getAccess p.arg) presentWhenName st, lv) )
+                        | ValidationStatementTrue   (st,lv)  -> ValidationStatementTrue (choice_child presentWhenName st true c_name, lv)
+                        | ValidationStatementFalse   (st,lv)
+                        | ValidationStatement   (st,lv)  -> ValidationStatement (choice_child presentWhenName st false c_name, lv) )
+                        //| ValidationStatementTrue   (st,lv)  -> ValidationStatementTrue (choice_OptionalChild (p.arg.joined l.lg) localTmpVarName (l.lg.getAccess p.arg) presentWhenName st, lv)
+                        //| ValidationStatementFalse  (st,lv)  -> ValidationStatement (choice_OptionalChild (p.arg.joined l.lg) localTmpVarName (l.lg.getAccess p.arg) presentWhenName st, lv)
+                        //| ValidationStatement       (st,lv)  -> ValidationStatement (choice_OptionalChild (p.arg.joined l.lg) localTmpVarName (l.lg.getAccess p.arg) presentWhenName st, lv) )
                 newFunc
             (*return new local variables, errorcodes or alphaFuncs*)
             match isValidFunction.funcName with
@@ -890,21 +905,26 @@ let createChoiceFunction (r:Asn1AcnAst.AstRoot)  (l:LanguageMacros) (t:Asn1AcnAs
     let valToStrFunc (p:CallerScope) (v:Asn1AcnAst.ChValue) = VCBTrue
     let vcbs, ns2 =  o.cons |> Asn1Fold.foldMap(fun cs c -> choiceConstraint2ValidationCodeBlock r l t.id children valToStrFunc defOrRef  c cs) ns1
     let funBody (errCode: ErrorCode) (p:CallerScope) =
-        let childrenChecks, lv1 =
-            let aaa, lv1 =
+        let choice_switch_check, lv1 =
+            let childrenChecks, lv1 =
                 childrenContent |>
                 List.choose(fun z ->
                     let isValidStatement = match z with IsValidEmbedded c -> c.isValidStatement | IsValidProcCall c -> c.isValidStatement
                     match isValidStatement p with
-                    | ValidationStatementTrue _ -> None
+                    | ValidationStatementTrue st
                     | ValidationStatementFalse  st
                     | ValidationStatement       st -> Some st) |>
                 List.unzip
-            aaa |> DAstUtilFunctions.nestItems_ret l  |> Option.toList, (lv1|> List.collect id)
+            //aaa |> DAstUtilFunctions.nestItems_ret l  |> Option.toList, (lv1|> List.collect id)
+            let choice_switch_check =
+                choice_check_children (p.arg.joined l.lg) (l.lg.getAccess p.arg) childrenChecks errCode.errCodeName
+
+            [choice_switch_check],(lv1|> List.collect id)
+
         let with_component_check, lv2 =
             let a, b = convertMultipleVCBsToStatementAndSetErrorCode l p errCode vcbs |> List.unzip
             a, (b |> List.collect id)
-        match (with_component_check@childrenChecks) |> DAstUtilFunctions.nestItems_ret l  with
+        match (with_component_check@choice_switch_check) |> DAstUtilFunctions.nestItems_ret l  with
         | None   -> convertVCBToStatementAndAssignedErrCode l VCBTrue errCode.errCodeName
         | Some s ->ValidationStatement (s, lv1@lv2)
 
@@ -1016,4 +1036,3 @@ let createReferenceTypeFunction (r:Asn1AcnAst.AstRoot) (l:LanguageMacros) (t:Asn
     let errorCodeComment = o.refCons |> List.map(fun z -> z.ASN1) |> Seq.StrJoin ""
 
     createIsValidFunction r l t funBody  typeDefinition [] [] [] [] (Some errorCodeComment) us
-

CommonTypes/AbstractMacros.fs

@@ -223,7 +223,7 @@ Generated by the C stg macros with the following command
         abstract member Choice_OptionalChild : p:string -> sPLocal:string -> sAcc:string -> sChPresent:string -> sInnerStatement:string -> string;
         abstract member Choice_child_always_present_Exp : p:string -> sAcc:string -> sChPresent:string -> string;
         abstract member Choice_child_always_absent_Exp : p:string -> sAcc:string -> sChPresent:string -> string;
-        abstract member choice_child : sChPresent:string -> sChildBody:string -> bAlwaysAbsent:bool -> string;
+        abstract member choice_child : sChPresent:string -> sChildBody:string -> bAlwaysAbsent:bool -> sChildName:string -> string;
         abstract member choice : p:string -> sAccess:string -> arrsChildren:seq<string> -> sErrCodeForInvalidCase:string -> string;
         abstract member sequenceOf : p:string -> sAcc:string -> i:string -> bIsFixedSize:bool -> nFixedSize:BigInteger -> soIsValidSizeExp:string option -> soErrCode:string option -> soInnerStatement:string option -> string;
         abstract member sequenceOf2 : p:string -> sAcc:string -> i:string -> bIsFixedSize:bool -> nFixedSize:BigInteger -> sInnerStatement:string -> string;
@@ -400,6 +400,7 @@ Generated by the C stg macros with the following command
         abstract member Real_32_little_endian : p:string -> sSuffix:string -> sErrCode:string -> codec:Codec -> string;
         abstract member Real_64_little_endian : p:string -> sErrCode:string -> codec:Codec -> string;
         abstract member Boolean : p:string -> ptr:string -> bEncValIsTrue:bool -> nSize:BigInteger -> arruTrueValueAsByteArray:seq<byte> -> arruFalseValueAsByteArray:seq<byte> -> arrsBits:seq<string> -> sErrCode:string -> codec:Codec -> string;
+        abstract member BooleanTrueFalse : p:string -> ptr:string -> nSize:BigInteger -> arruTrueValueAsByteArray:seq<byte> -> arruFalseValueAsByteArray:seq<byte> -> arrsTrueBits:seq<string> -> arrsFalseBits:seq<string> -> sErrCode:string -> codec:Codec -> string;
         abstract member Null_declare : p:string -> string;
         abstract member Null_pattern : p:string -> arruNullValueAsByteArray:seq<byte> -> nSize:BigInteger -> arrsBits:seq<string> -> sErrCode:string -> bSavePosition:bool -> codec:Codec -> string;
         abstract member Null_pattern2 : p:string -> arruNullValueAsByteArray:seq<byte> -> nSize:BigInteger -> arrsBits:seq<string> -> sErrCode:string -> bSavePosition:bool -> codec:Codec -> string;

CommonTypes/AcnGenericTypes.fs

@@ -346,18 +346,17 @@ type ObjectIdTypeAcnProperties = {
 }
 
 
-type AcnBooleanEncoding =
-    | TrueValue    of StringLoc
-    | FalseValue   of StringLoc
+type AcnBooleanEncoding = 
+    | TrueValueEncoding of StringLoc //the user specifies only the true value. All other values are considered false
+    | FalseValueEncoding of StringLoc //the user specifies only the false value. All other values are considered true
+    | TrueFalseValueEncoding of StringLoc*StringLoc //the user specifies both true and false values
+
 with
-    member this.bitVal =
-        match this with
-        | TrueValue bv -> bv
-        | FalseValue bv -> bv
-    member this.isTrue =
+    member this.bitValLength = 
         match this with
-        | TrueValue _ -> true
-        | FalseValue _ -> false
+        | TrueValueEncoding tv -> tv.Value.Length
+        | FalseValueEncoding fv -> fv.Value.Length
+        | TrueFalseValueEncoding (tv,_) -> tv.Value.Length
 
 type BooleanAcnProperties = {
     encodingPattern     : AcnBooleanEncoding    option