Fix for bug #1350

- Check for invalid named fields in pattern record deconstructor


git-svn-id: https://openmodelica.org/svn/OpenModelica/branches/sjoelund-functiontree@6918 f25d12d1-65f4-0310-ae8a-bbce733d8d8e

Compiler/Error.mo

@@ -282,6 +282,7 @@ public constant ErrorID META_MATCH_GENERAL_FAILURE=5014;
 public constant ErrorID META_CONS_TYPE_MATCH=5015;
 public constant ErrorID META_STRICT_RML_MATCH_IN_OUT=5016;
 public constant ErrorID META_NONE_CREF=5017;
+public constant ErrorID META_INVALID_PATTERN_NAMED_FIELD=5018;
 
 protected constant list<tuple<Integer, MessageType, Severity, String>> errorTable=
          {(SYNTAX_ERROR,SYNTAX(),ERROR(),"Syntax error near: %s"),
@@ -637,7 +638,8 @@ protected constant list<tuple<Integer, MessageType, Severity, String>> errorTabl
           (META_CONS_TYPE_MATCH,TRANSLATION(),ERROR(),"Failed to match types of cons expression %s. The head has type %s and the tail %s."),
           (LOOKUP_FUNCTION_GOT_CLASS,TRANSLATION(),ERROR(),"Looking for a function %s but found a %s."),
           (META_STRICT_RML_MATCH_IN_OUT,TRANSLATION(),ERROR(),"%s. Strict RML enforces match expression input and output to be the same as the function's."),
-          (META_NONE_CREF,TRANSLATION(),ERROR(),"NONE is not acceptable syntax. Use NONE() instead.")
+          (META_NONE_CREF,TRANSLATION(),ERROR(),"NONE is not acceptable syntax. Use NONE() instead."),
+          (META_INVALID_PATTERN_NAMED_FIELD,TRANSLATION(),ERROR(),"Invalid named fields: %s")
           };
 
 protected import ErrorExt;

Compiler/Patternm.mo

@@ -485,7 +485,7 @@ algorithm
       RenamedPatList renamedPatList;
       RenamedPat pat,first2,second2;
       Integer constTag,i,numPosArgs;
-      list<Absyn.NamedArg> namedArgList;
+      list<Absyn.NamedArg> namedArgList,invalidArgs;
       Absyn.Path recName,pathName;
       SCode.Class sClass;
       list<String> fieldNameList, fieldNamesPos, fieldNamesNamed;
@@ -610,8 +610,7 @@ algorithm
       then (localCache,pat,listAppend(localAsBinds,localAsBinds2),localConstTagEnv,status);
 
         // CALL EXPRESSION - translates pos/named args into only pos ones
-    case (Absyn.CALL(compRef,Absyn.FUNCTIONARGS(funcArgs,namedArgList)),
-        localVar,localAsBinds,localCache,localEnv,localConstTagEnv,info)
+    case (Absyn.CALL(compRef,Absyn.FUNCTIONARGS(funcArgs,namedArgList)),localVar,localAsBinds,localCache,localEnv,localConstTagEnv,info)
       equation
         recName = Absyn.crefToPath(compRef);
 
@@ -627,13 +626,12 @@ algorithm
         (_,fieldNamesNamed) = Util.listSplit(fieldNameList, numPosArgs);
 
         //Sorting of named arguments
-        funcArgsNamedFixed = generatePositionalArgs(fieldNamesNamed,namedArgList,{});
+        (funcArgsNamedFixed,invalidArgs) = generatePositionalArgs(fieldNamesNamed,namedArgList,{});
         funcArgs = listAppend(funcArgs,funcArgsNamedFixed);
 
-        (localCache,renamedPatList,localAsBinds2,localConstTagEnv,status) = renamePatList(funcArgs
-          ,localVar2,1,{},{},localCache,localEnv,localConstTagEnv,info);
+        (localCache,renamedPatList,localAsBinds2,localConstTagEnv,status) = renamePatList(funcArgs,localVar2,1,{},{},localCache,localEnv,localConstTagEnv,info);
         pat = DFA.RP_CALL(localVar,compRef,renamedPatList);
-
+        status = checkInvalidPatternNamedArgs(invalidArgs,status,info);
       then (localCache,pat,listAppend(localAsBinds,localAsBinds2),localConstTagEnv,status);
         // EMPTY LIST EXPRESSION
     case (Absyn.ARRAY({}),localVar,localAsBinds,localCache,_,localConstTagEnv,info)
@@ -2000,22 +1998,21 @@ protected function generatePositionalArgs "function: generatePositionalArgs
   input list<Absyn.NamedArg> namedArgList;
   input list<Absyn.Exp> accList;
   output list<Absyn.Exp> outList;
+  output list<Absyn.NamedArg> outInvalidNames;
 algorithm
-  outList :=
-  matchcontinue (fieldNameList,namedArgList,accList)
+  (outList,outInvalidNames) := matchcontinue (fieldNameList,namedArgList,accList)
     local
       list<Absyn.Exp> localAccList;
       list<Absyn.Ident> restFieldNames;
       Absyn.Ident firstFieldName;
-      list<Absyn.Exp> expL;
+      Absyn.Exp exp;
       list<Absyn.NamedArg> localNamedArgList;
-    case ({},_,localAccList) then localAccList;
+    case ({},namedArgList,localAccList) then (listReverse(localAccList),namedArgList);
     case (firstFieldName :: restFieldNames,localNamedArgList,localAccList)
       equation
-        expL = Util.listCreate(findFieldExpInList(firstFieldName,localNamedArgList));
-        localAccList = listAppend(localAccList,expL);
-        localAccList = generatePositionalArgs(restFieldNames,localNamedArgList,localAccList);
-      then localAccList;
+        (exp,localNamedArgList) = findFieldExpInList(firstFieldName,localNamedArgList);
+        (localAccList,localNamedArgList) = generatePositionalArgs(restFieldNames,localNamedArgList,exp::localAccList);
+      then (localAccList,localNamedArgList);
   end matchcontinue;
 end generatePositionalArgs;
 
@@ -2026,22 +2023,23 @@ protected function findFieldExpInList "function: findFieldExpInList
   input Absyn.Ident firstFieldName;
   input list<Absyn.NamedArg> namedArgList;
   output Absyn.Exp outExp;
+  output list<Absyn.NamedArg> outNamedArgList;
 algorithm
-  outExp :=
-  matchcontinue (firstFieldName,namedArgList)
+  (outExp,outNamedArgList) := matchcontinue (firstFieldName,namedArgList)
     local
       Absyn.Exp e;
       Absyn.Ident localFieldName,aName;
-      list<Absyn.NamedArg> restNamedArgList;
-    case (_,{}) then Absyn.CREF(Absyn.WILD());
-    case (localFieldName,Absyn.NAMEDARG(aName,e) :: _)
+      list<Absyn.NamedArg> rest;
+      Absyn.NamedArg first;
+    case (_,{}) then (Absyn.CREF(Absyn.WILD()),{});
+    case (localFieldName,Absyn.NAMEDARG(aName,e) :: rest)
       equation
         true = stringEq(localFieldName,aName);
-      then e;
-    case (localFieldName,_ :: restNamedArgList)
+      then (e,rest);
+    case (localFieldName,first::rest)
       equation
-        e = findFieldExpInList(localFieldName,restNamedArgList);
-      then e;
+        (e,rest) = findFieldExpInList(localFieldName,rest);
+      then (e,first::rest);
   end matchcontinue;
 end findFieldExpInList;
 
@@ -2630,4 +2628,25 @@ algorithm
   end matchcontinue;
 end getCaseDecls;
 
+protected function checkInvalidPatternNamedArgs
+"Checks that there are no invalid named arguments in the pattern"
+  input list<Absyn.NamedArg> args;
+  input Util.Status status;
+  input Absyn.Info info;
+  output Util.Status outStatus;
+algorithm
+  outStatus := match (args,status,info)
+    local
+      list<String> argsNames;
+      String str1;
+    case ({},status,_) then status;
+    case (args,status,info)
+      equation
+        (argsNames,_) = Absyn.getNamedFuncArgNamesAndValues(args);
+        str1 = Util.stringDelimitList(argsNames, ",");
+        Error.addSourceMessage(Error.META_INVALID_PATTERN_NAMED_FIELD, {str1}, info);
+      then Util.FAILURE();
+  end match;
+end checkInvalidPatternNamedArgs;
+
 end Patternm;