xquery 4 switch allowing sequences

data/tests/xquery4_tests.pas

@@ -28,6 +28,9 @@ procedure t(a,b: string; c: string = '');
 
   t('for member $m at $i in [10,20,30] return $m + $i', '11 22 33');
 
+//errortest('switch ((1,2)) case 1 return A case (1,2) return B default return "D"', 'x');
+  t('switch (1) case 3 return "A" case 1,2 return "B" default return "D"', 'B');
+
   writeln('XQuery 4.0 ', tester.count, ' completed');
   tester.free
 end;

data/xquery__parse.pas

@@ -1900,30 +1900,48 @@ function TXQParsingContext.parseSwitch: TXQTermSwitch;
 var
   word: String;
   tempSeq: TXQTermWithChildren;
+  braced: boolean;
 begin
   requireXQuery3('for switch statement');
-  expect('(');
   result := TXQTermSwitch.Create;
-  result.push(parsePrimaryLevel());
-  expect(')');
-
-  word := nextToken();
-  if word <> 'case' then raiseSyntaxError('Need at least one case');
-  while word = 'case' do begin
+  try
     skipWhitespaceAndComment();
-    tempSeq := TXQTermWithChildren.Create;
-    result.push(tempSeq);
+    if pos^ = '(' then begin
+      expect('(');
+      result.push(parsePrimaryLevel());
+      expect(')');
+    end else begin
+      require4('switch (..) case ... OR xpath 4: switch (x) { case ... } ');
+      if not (pos^ in ['{', 'c']) then
+        raiseSyntaxError('switch (..) case ... OR xpath 4: switch (x) { case ... } ');
+      result.push(TXQTermConstant.create(xqvalueTrue));
+    end;
+    braced := nextTokenIs('{');
+
+    word := nextToken();
+    if word <> 'case' then raiseSyntaxError('Need at least one case');
     while word = 'case' do begin
+      skipWhitespaceAndComment();
+      tempSeq := TXQTermWithChildren.Create;
+      result.push(tempSeq);
+      while word = 'case' do begin
+        if parsingModel in PARSING_MODEL4 then tempSeq.push(parsePrimaryLevel())
+        else tempSeq.push(parse());
+        word := nextToken();
+      end;
+      if word <> 'return' then raiseSyntaxError('expected return');
       tempSeq.push(parse());
       word := nextToken();
     end;
-    if word <> 'return' then raiseSyntaxError('expected return');
-    tempSeq.push(parse());
-    word := nextToken();
+    if word <> 'default' then raiseSyntaxError('expected "default" clause');
+    expect('return');
+    result.push(parse());
+
+    if braced then expect('}');
+  except
+    result.free;
+    raise;
   end;
-  if word <> 'default' then raiseSyntaxError('expected "default" clause');
-  expect('return');
-  result.push(parse());
 end;
 
 function TXQParsingContext.parseDirectConstructor(): TXQTermConstructor;

data/xquery_terms.inc

@@ -3891,6 +3891,7 @@ var
   i, j: SizeInt;
   operand: IXQValue;
   seq: TXQTermWithChildren;
+  pv: PIXQValue;
 begin
   v := children[0].evaluate(context);
   if v.getSequenceCount > 1 then raiseXPTY0004TypeError(v, 'singleton');
@@ -3900,7 +3901,14 @@ begin
     seq := TXQTermWithChildren(children[i]);
     for j := 0 to high(seq.children) - 1 do begin
       operand := xqvalueAtomize(seq.children[j].evaluate(context));
-      if operand.getSequenceCount > 1 then raiseXPTY0004TypeError(operand, 'Sequences are not allowed as case operands in a switch statement');
+      if operand.getSequenceCount > 1 then begin
+        if not (context.staticContext.model in PARSING_MODEL4) then
+          raiseXPTY0004TypeError(operand, 'Sequences are not allowed as case operands in a switch statement');
+        for pv in operand.GetEnumeratorPtrUnsafe do
+          if xqvalueDeep_equal(context, v, pv^, context.staticContext.collation) then
+            exit(seq.children[high(seq.children)].evaluate(context));
+        continue;
+      end;
       if xqvalueDeep_equal(context, v, operand, context.staticContext.collation) then
         exit(seq.children[high(seq.children)].evaluate(context));
     end;