diff --git a/compiler/src/main/pascal/blaise.codegen.qbe.pas b/compiler/src/main/pascal/blaise.codegen.qbe.pas index 1c9c673..819849a 100644 --- a/compiler/src/main/pascal/blaise.codegen.qbe.pas +++ b/compiler/src/main/pascal/blaise.codegen.qbe.pas @@ -4941,6 +4941,18 @@ begin begin Exit(EmitExpr(Fld)); end; + { Qualified static-var read used as an instance pointer (TFoo.GObj.Field / + TFoo.GObj.Method()): the class-typed static var's global slot holds the + instance pointer — load it directly. Static getter (IsStaticPropGet) + results are full expressions, so EmitExpr handles those. } + if Fld.IsClassVarRead then + begin + Loaded := AllocTemp(); + EmitLine(Format(' %s =l loadl $%s', [Loaded, Fld.ClassVarEmitName])); + Exit(Loaded); + end; + if Fld.IsStaticPropGet then + Exit(EmitExpr(Fld)); if Fld.Base <> nil then Base := EmitInstancePtr(Fld.Base) else if Fld.IsImplicitSelf then @@ -11962,6 +11974,21 @@ begin Exit(T); end; + { Static var read: TypeName.StaticVar — a plain global load of the mangled + label. Checked BEFORE the chained-access branch: a qualified static var + shaped by the parser as a Base-form access (Base is the bare class-name + ident) still has IsClassVarRead set and must NOT be treated as a chained + field of the metaclass. } + if FldAccess.IsClassVarRead then + begin + QType := QbeTypeOf(FldAccess.ResolvedType); + LoadInstr := LoadInstrFor(FldAccess.ResolvedType); + T := AllocTemp(); + EmitLine(Format(' %s =%s %s $%s', + [T, QType, LoadInstr, FldAccess.ClassVarEmitName])); + Exit(T); + end; + { Chained access: compute base storage pointer, then load the field from (base_ptr + offset) using the field's QBE type. } if FldAccess.Base <> nil then diff --git a/compiler/src/main/pascal/uSemantic.pas b/compiler/src/main/pascal/uSemantic.pas index f44d3a1..b1ef2ac 100644 --- a/compiler/src/main/pascal/uSemantic.pas +++ b/compiler/src/main/pascal/uSemantic.pas @@ -11340,6 +11340,53 @@ begin if AAccess.Base <> nil then begin BaseType := AnalyseExpr(AAccess.Base); + { Metaclass base: 'TypeName.StaticVar' or 'TypeName.StaticProp' arriving as + a chained access (Base is the bare class-name ident resolving to + 'class of TypeName') rather than the simple RecordName form. This is how + the parser shapes a qualified static-var/property used as the BASE of a + further chain on an l-value, e.g. 'TFoo.GObj.V := x' or 'TFoo.GObj.M()'. + Resolve it exactly like the RecordName static-var/static-prop read below, + so the result type feeds the outer chain. } + if BaseType.Kind = tyMetaClass then + begin + RT := TRecordTypeDesc(TMetaClassTypeDesc(BaseType).BaseClass); + Sym := FTable.Lookup(RT.Name + '.' + AAccess.FieldName); + if (Sym <> nil) and (Sym.Kind = skVariable) and Sym.IsClassVar then + begin + AssertStaticVarVisible(Sym.Visibility, Sym.OwningUnit, + Sym.OwnerTypeName, AAccess.FieldName, + AAccess.Line, AAccess.Col); + AAccess.IsClassVarRead := True; + AAccess.IsGlobal := True; + AAccess.ClassVarEmitName := Sym.GlobalEmitName; + AAccess.ResolvedType := Sym.TypeDesc; + Exit(Sym.TypeDesc); + end; + PropInfo := RT.FindProperty(AAccess.FieldName); + if (PropInfo <> nil) and PropInfo.IsStatic then + begin + if PropInfo.ReadMethod = '' then + SemanticError( + Format('Static property ''%s.%s'' has no readable static getter', + [RT.Name, AAccess.FieldName]), + AAccess.Line, AAccess.Col); + MDecl := FindMethodDecl(RT.Name, PropInfo.ReadMethod); + if (MDecl = nil) or not MDecl.IsStatic then + SemanticError( + Format('Static property ''%s.%s'' getter ''%s'' is not a static method', + [RT.Name, AAccess.FieldName, PropInfo.ReadMethod]), + AAccess.Line, AAccess.Col); + AAccess.IsStaticPropGet := True; + AAccess.ResolvedMethod := MDecl; + AAccess.ResolvedClassType := BaseType; + AAccess.ResolvedType := MDecl.ResolvedReturnType; + Exit(MDecl.ResolvedReturnType); + end; + SemanticError( + Format('Unknown static member ''%s'' on type ''%s''', + [AAccess.FieldName, RT.Name]), + AAccess.Line, AAccess.Col); + end; if not (BaseType.Kind in [tyRecord, tyClass]) then SemanticError( Format('Field access ''.%s'' requires a record or class base, got ''%s''', diff --git a/compiler/src/test/pascal/cp.test.e2e.staticmembers.pas b/compiler/src/test/pascal/cp.test.e2e.staticmembers.pas index 846a85a..da086f7 100644 --- a/compiler/src/test/pascal/cp.test.e2e.staticmembers.pas +++ b/compiler/src/test/pascal/cp.test.e2e.staticmembers.pas @@ -32,6 +32,7 @@ type procedure TestRun_StaticVar_QualifiedWrite_Scalar; procedure TestRun_StaticVar_QualifiedWrite_ClassARC; procedure TestRun_StaticVar_InterfaceStore; + procedure TestRun_StaticVar_ChainedLValueBase; procedure TestRun_StaticProperty_QualifiedRead; procedure TestRun_Singleton_LazyGetInstance; procedure TestRun_StaticConst_OnClass; @@ -222,6 +223,47 @@ begin AssertRunsOnAll(Src, 'thing 7' + LineEnding, 0); end; +procedure TE2EStaticMembersTests.TestRun_StaticVar_ChainedLValueBase; +{ A qualified static var of class type used as the BASE of a further l-value + chain: 'TFoo.GObj.Field := V' (field write through the chained base) and + 'TFoo.GObj.Method()' (method call on the chained base). The read form + (TFoo.GObj.Field as an expression) already worked; the write/call receiver + path through the chained base was unresolved ("Field access requires a record + or class base, got 'class of TFoo'"). } +const Src = + ''' + program P; + type + TObj = class + public + V: Integer; + procedure Bump; + end; + THolder = class + public static var + GObj: TObj; + end; + procedure TObj.Bump; + begin + V := V + 1; + end; + begin + THolder.GObj := TObj.Create(); + WriteLn(THolder.GObj.V); + THolder.GObj.V := 5; + WriteLn(THolder.GObj.V); + THolder.GObj.Bump(); + WriteLn(THolder.GObj.V); + THolder.GObj := nil + end. + '''; +var LE: string; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end; + LE := LineEnding; + AssertRunsOnAll(Src, '0' + LE + '5' + LE + '6' + LE, 0); +end; + procedure TE2EStaticMembersTests.TestRun_StaticProperty_QualifiedRead; const Src = ''' diff --git a/compiler/src/test/pascal/cp.test.staticmembers.pas b/compiler/src/test/pascal/cp.test.staticmembers.pas index f87fa38..af8180a 100644 --- a/compiler/src/test/pascal/cp.test.staticmembers.pas +++ b/compiler/src/test/pascal/cp.test.staticmembers.pas @@ -588,6 +588,7 @@ type procedure TestIR_StaticProperty_QualifiedRead_CallsGetter; procedure TestIR_ClassStaticVar_ReleasedAtExit; procedure TestIR_StaticCall_InterfaceArg_NoLeadingComma; + procedure TestIR_StaticVar_ChainedLValueBase_LoadsGlobal; end; function TStaticMembersSemTests.AnalyseSrc(const ASrc: string): TProgram; @@ -1041,6 +1042,38 @@ begin Pos('call $THolder_SetIt(l ', IR) >= 0); end; +procedure TStaticMembersSemTests.TestIR_StaticVar_ChainedLValueBase_LoadsGlobal; +{ A qualified static var of class type used as the base of a further l-value + chain (THolder.GObj.V := 5) must resolve and lower: the base instance pointer + is loaded from the static var's mangled global slot. Without the fix the + semantic pass rejected the write with "requires a record or class base, got + 'class of THolder'". } +const + Src = + ''' + program P; + type + TObj = class + public + V: Integer; + end; + THolder = class + public static var + GObj: TObj; + end; + begin + THolder.GObj := TObj.Create(); + THolder.GObj.V := 5; + end. + '''; +var IR: string; +begin + IR := GenIR(Src); + { The chained write loads the base instance pointer from the static var slot. } + AssertTrue('chained l-value base loads static var global', + Pos('loadl $THolder_GObj', IR) >= 0); +end; + initialization RegisterTest(TStaticMembersParseTests); RegisterTest(TStaticMembersSemTests);