Browse Source

fcl-passrc: resolver: check arg access

git-svn-id: trunk@43225 -
Mattias Gaertner 5 years ago
parent
commit
8663dbdd4d

+ 2 - 2
packages/fcl-passrc/src/pasresolver.pp

@@ -8334,6 +8334,8 @@ procedure TPasResolver.FinishArgument(El: TPasArgument);
 var
   IsDelphi: Boolean;
 begin
+  if not (El.Access in [argDefault,argConst,argVar,argOut]) then
+    RaiseMsg(20191018235644,nNotYetImplemented,sNotYetImplemented,[AccessDescriptions[El.Access]],El);
   if El.ArgType<>nil then
     CheckUseAsType(El.ArgType,20190123100049,El);
   if El.ValueExpr<>nil then
@@ -12468,8 +12470,6 @@ begin
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.AddArgument ',GetObjName(El));
   {$ENDIF}
-  if El.Access in [argDefault,argConst,argVar,argOut] then
-    RaiseNotYetImplemented(20191018235644,El,AccessNames[El.Access]);
   CurScope:=TopScope;
   if (CurScope=nil) then
     RaiseInvalidScopeForElement(20160922163529,El);

+ 0 - 25
packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -144,7 +144,6 @@ type
     procedure TestGenProc_TypeParamCntOverloadNoParams;
     procedure TestGenProc_TypeParamWithDefaultParamDelphiFail;
     // ToDo: NestedResultAssign
-    procedure TestGenProc_OverloadsOtherUnit;
 
     // generic function infer types
     procedure TestGenProc_Infer_NeedExplicitFail;
@@ -2148,30 +2147,6 @@ begin
   CheckResolverException(sParamOfThisTypeCannotHaveDefVal,nParamOfThisTypeCannotHaveDefVal);
 end;
 
-procedure TTestResolveGenerics.TestGenProc_OverloadsOtherUnit;
-begin
-  AddModuleWithIntfImplSrc('ns1.unit2.pp',
-    LinesToStr([
-    'var i2: longint;']),
-    LinesToStr([
-    '']));
-
-  AddModuleWithIntfImplSrc('ns1.unit1.pp',
-    LinesToStr([
-    'uses unit2;',
-    'var j1: longint;']),
-    LinesToStr([
-    '']));
-
-  StartProgram(true);
-  Add([
-  'uses unit1;',
-  'begin',
-  '  if j1=0 then ;',
-  '']);
-  ParseProgram;
-end;
-
 procedure TTestResolveGenerics.TestGenProc_Infer_NeedExplicitFail;
 begin
   StartProgram(false);

+ 6 - 6
packages/fcl-passrc/tests/tcresolver.pas

@@ -6110,7 +6110,7 @@ begin
   Add('begin');
   Add('end;');
   Add('begin');
-  CheckResolverException('not yet implemented: a:TPasArgument [20191018235644]',nNotYetImplemented);
+  CheckResolverException('not yet implemented: constref',nNotYetImplemented);
 end;
 
 procedure TTestResolver.TestFunctionResult;
@@ -7283,7 +7283,7 @@ begin
   Add('procedure {#ProcA}ProcA(var {#A}A); forward;');
   Add('procedure {#ProcB}ProcB(const {#B}B); forward;');
   Add('procedure {#ProcC}ProcC(out {#C}C); forward;');
-  Add('procedure {#ProcD}ProcD(constref {#D}D); forward;');
+  //Add('procedure {#ProcD}ProcD(constref {#D}D); forward;');
   Add('procedure ProcA(var A);');
   Add('begin');
   Add('end;');
@@ -7293,15 +7293,15 @@ begin
   Add('procedure ProcC(out C);');
   Add('begin');
   Add('end;');
-  Add('procedure ProcD(constref D);');
-  Add('begin');
-  Add('end;');
+  //Add('procedure ProcD(constref D);');
+  //Add('begin');
+  //Add('end;');
   Add('var i: longint;');
   Add('begin');
   Add('  {@ProcA}ProcA(i);');
   Add('  {@ProcB}ProcB(i);');
   Add('  {@ProcC}ProcC(i);');
-  Add('  {@ProcD}ProcD(i);');
+  //Add('  {@ProcD}ProcD(i);');
   ParseProgram;
 end;