fcl-passrc: fixed parsing proc p(var a; b: t)

git-svn-id: trunk@38543 -

packages/fcl-passrc/src/pasresolver.pp

@@ -3987,6 +3987,8 @@ var
   IsClassScope: Boolean;
   C: TClass;
 begin
+  if aName='' then exit(nil);
+
   IsClassScope:=(Scope is TPasClassScope);
 
   if (El.Visibility=visPublished) then
@@ -4409,9 +4411,12 @@ begin
   Decl.Types.Add(El);
   if (El.ClassType=TPasEnumType) and (Parent.ClassType=TPasSetType) then
     begin
+    // anonymous enumtype
     EnumScope:=TPasEnumTypeScope(El.CustomData);
     if EnumScope.CanonicalSet<>Parent then
       begin
+      // When a TPasEnumType is created a CanonicalSet is created.
+      // Release the autocreated CanonicalSet and use the parent.
       if EnumScope.CanonicalSet<>nil then
         EnumScope.CanonicalSet.Release;
       EnumScope.CanonicalSet:=TPasSetType(Parent);
@@ -7600,9 +7605,17 @@ begin
   AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple);
   PushScope(El,TPasEnumTypeScope);
   // add canonical set
-  CanonicalSet:=TPasSetType.Create('',El);
-  CanonicalSet.EnumType:=El;
-  El.AddRef;
+  if El.Parent is TPasSetType then
+    begin
+    CanonicalSet:=TPasSetType(El.Parent);
+    CanonicalSet.AddRef;
+    end
+  else
+    begin
+    CanonicalSet:=TPasSetType.Create('',El);
+    CanonicalSet.EnumType:=El;
+    El.AddRef;
+    end;
   TPasEnumTypeScope(TopScope).CanonicalSet:=CanonicalSet;
 end;
 

packages/fcl-passrc/src/pparser.pp

@@ -4284,29 +4284,29 @@ begin
     Access := argDefault;
     IsUntyped := False;
     ArgType := nil;
+    NextToken;
+    if CurToken = tkConst then
+    begin
+      Access := argConst;
+      Name := ExpectIdentifier;
+    end else if CurToken = tkConstRef then
+    begin
+      Access := argConstref;
+      Name := ExpectIdentifier;
+    end else if CurToken = tkVar then
+    begin
+      Access := ArgVar;
+      Name := ExpectIdentifier;
+    end else if (CurToken = tkIdentifier) and (UpperCase(CurTokenString) = 'OUT') then
+    begin
+      Access := ArgOut;
+      Name := ExpectIdentifier;
+    end else if CurToken = tkIdentifier then
+      Name := CurTokenString
+    else
+      ParseExc(nParserExpectedConstVarID,SParserExpectedConstVarID);
     while True do
     begin
-      NextToken;
-      if CurToken = tkConst then
-      begin
-        Access := argConst;
-        Name := ExpectIdentifier;
-      end else if CurToken = tkConstRef then
-      begin
-        Access := argConstref;
-        Name := ExpectIdentifier;
-      end else if CurToken = tkVar then
-      begin
-        Access := ArgVar;
-        Name := ExpectIdentifier;
-      end else if (CurToken = tkIdentifier) and (UpperCase(CurTokenString) = 'OUT') then
-      begin
-        Access := ArgOut;
-        Name := ExpectIdentifier;
-      end else if CurToken = tkIdentifier then
-        Name := CurTokenString
-      else
-        ParseExc(nParserExpectedConstVarID,SParserExpectedConstVarID);
       Arg := TPasArgument(CreateElement(TPasArgument, Name, Parent));
       Arg.Access := Access;
       Args.Add(Arg);
@@ -4323,11 +4323,16 @@ begin
       end
       else if CurToken <> tkComma then
         ParseExc(nParserExpectedCommaColon,SParserExpectedCommaColon);
+      NextToken;
+      if CurToken = tkIdentifier then
+        Name := CurTokenString
+      else
+        ParseExc(nParserExpectedConstVarID,SParserExpectedConstVarID);
     end;
     Value:=Nil;
     if not IsUntyped then
       begin
-      Arg := TPasArgument(Args[0]);
+      Arg := TPasArgument(Args[OldArgCount]);
       ArgType := ParseType(Arg,CurSourcePos);
       ok:=false;
       try

packages/fcl-passrc/tests/tcresolver.pas

@@ -363,6 +363,7 @@ type
     Procedure TestProcOverloadWithBaseTypes2;
     Procedure TestProcOverloadNearestHigherPrecision;
     Procedure TestProcCallLowPrecision;
+    Procedure TestProcOverloadUntyped;
     Procedure TestProcOverloadMultiLowPrecisionFail;
     Procedure TestProcOverloadWithClassTypes;
     Procedure TestProcOverloadWithInhClassTypes;
@@ -5379,6 +5380,22 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestProcOverloadUntyped;
+begin
+  StartProgram(false);
+  Add([
+  'procedure {#a}DoIt(a, b: longint); external;',
+  'procedure {#b}DoIt(const a; b: longint); external;',
+  'var',
+  '  a: longint;',
+  '  b: boolean;',
+  'begin',
+  '  {@a}DoIt(a,a);',
+  '  {@b}DoIt(b,a);',
+  '']);
+  ParseProgram;
+end;
+
 procedure TTestResolver.TestProcOverloadMultiLowPrecisionFail;
 begin
   StartProgram(false);