Browse Source

* Implicitly use Variants unit when (ole)Variant type appears as a function/operator result and nowhere else. Mantis #24863.

git-svn-id: trunk@25261 -
sergei 12 years ago
parent
commit
c558991d8f
3 changed files with 66 additions and 1 deletions
  1. 1 0
      .gitattributes
  2. 5 1
      compiler/pdecsub.pas
  3. 60 0
      tests/webtbs/tw24863.pp

+ 1 - 0
.gitattributes

@@ -13476,6 +13476,7 @@ tests/webtbs/tw2480.pp svneol=native#text/plain
 tests/webtbs/tw2481.pp svneol=native#text/plain
 tests/webtbs/tw2483.pp svneol=native#text/plain
 tests/webtbs/tw24848.pp svneol=native#text/pascal
+tests/webtbs/tw24863.pp svneol=native#text/plain
 tests/webtbs/tw2492.pp svneol=native#text/plain
 tests/webtbs/tw2494.pp svneol=native#text/plain
 tests/webtbs/tw2503.pp svneol=native#text/plain

+ 5 - 1
compiler/pdecsub.pas

@@ -103,7 +103,7 @@ implementation
        { parameter handling }
        paramgr,cpupara,
        { pass 1 }
-       fmodule,node,htypechk,ncon,
+       fmodule,node,htypechk,ncon,ppu,
        objcutil,
        { parser }
        scanner,
@@ -1078,6 +1078,10 @@ implementation
               end;
             single_type(pd.returndef,[stoAllowSpecialization]);
 
+            if ((pd.returndef=cvarianttype) or (pd.returndef=colevarianttype)) and
+               not(cs_compilesystem in current_settings.moduleswitches) then
+              current_module.flags:=current_module.flags or uf_uses_variants;
+
             if is_dispinterface(pd.struct) and not is_automatable(pd.returndef) then
               Message1(type_e_not_automatable,pd.returndef.typename);
 

+ 60 - 0
tests/webtbs/tw24863.pp

@@ -0,0 +1,60 @@
+program test2;
+
+{$mode objfpc}{$H+}
+
+// This demo program abuses FPC's custom operator facility to simulate
+// Vector Pascal's \+ (reduce-add) operator, which is derived from APL's
+// +/ function/operator.
+//
+// If the dummy record type (TReduce) is empty, there will be a runtime error
+// when the operator result is assigned. This can be fixed either by
+// explicitly importing the Variants unit, or by changing the operator
+// function to return an integer.
+
+type	t1= array of integer;
+	TReduce= record
+//	           x: variant
+	         end;
+
+var	a1: t1;
+	reduce: TReduce = ();
+
+
+procedure print(const a: t1);
+
+var	i: integer;
+
+begin
+  for i := Low(a) to High(a) do
+    Write(a[i], ' ');
+  WriteLn
+end { print } ;
+
+
+operator + (const r: TReduce; const a: t1): variant;
+
+var	i: integer;
+
+begin
+  result := 0;
+  for i := Low(a) to High(a) do
+    result += a[i]
+end { + } ;
+
+
+begin
+//  a1 := t1.create(1,2,3,4,5);	Requires trunk
+//  a1 := t1([1,2,3,4,5]);	Doesn't work without tuple support
+  SetLength(a1, 5);
+  a1[0] := 1;
+  a1[1] := 2;
+  a1[2] := 3;
+  a1[3] := 4;
+  a1[4] := 5;
+  WriteLn('a1:');
+  print(a1);
+  WriteLn('+/ a1:');
+  WriteLn(reduce + a1);
+  WriteLn
+end.
+