diff --git a/compiler/src/main/pascal/uParser.pas b/compiler/src/main/pascal/uParser.pas index 4931e13..c53c269 100644 --- a/compiler/src/main/pascal/uParser.pas +++ b/compiler/src/main/pascal/uParser.pas @@ -58,6 +58,8 @@ type function Check(AKind: TTokenKind): Boolean; function CheckUnitNamePart: Boolean; function ParseTypeName: string; { reads Ident optionally followed by '<' ArgList '>' } + function SubrangeAhead: Boolean; { current token starts an integer-literal subrange: IntLit.. or -IntLit.. } + function ParseIntegerSubrangeBaseType: string; { parse lo..hi, return narrowest fitting standard integer type } function ReadConstBoundText: string; { read an array bound: literal, ident, or expr } function ParseAnonEnumName: string; { parse '(a,b,c)' → encoded member-list string } @@ -409,6 +411,70 @@ begin end; end; +function TParser.SubrangeAhead: Boolean; +begin + { An integer-literal subrange in a type RHS: `0..255` or `-10..10`. + Recognised by a leading integer literal (optionally a minus sign) followed + by the '..' token. Pure lookahead — consumes nothing. } + if Check(tkIntLit) then + Result := (PeekKind() = tkDotDot) + else if Check(tkMinus) then + Result := (PeekKind() = tkIntLit) and (PeekKind2() = tkDotDot) + else + Result := False; +end; + +function TParser.ParseIntegerSubrangeBaseType: string; +var + Lo, Hi: Int64; + Neg: Boolean; +begin + { Parse `lo..hi` (each an integer literal, lo optionally negative) and return + the name of the narrowest STANDARD integer type that holds both bounds. + Blaise performs no range checking, so a named subrange is just an alias to + this base type; the choice keeps record/array element layout correct + (e.g. 0..255 is byte-sized). } + Neg := False; + if Check(tkMinus) then begin Neg := True; Advance(); end; + if not Check(tkIntLit) then + raise EParseError.Create(Format( + 'Expected integer literal as subrange lower bound at line %d col %d in %s', + [FCurrent.Line, FCurrent.Col, FLexer.Filename])); + Lo := ParseIntLiteral(FCurrent.Value); + if Neg then Lo := -Lo; + Advance(); + Expect(tkDotDot); + Neg := False; + if Check(tkMinus) then begin Neg := True; Advance(); end; + if not Check(tkIntLit) then + raise EParseError.Create(Format( + 'Expected integer literal as subrange upper bound at line %d col %d in %s', + [FCurrent.Line, FCurrent.Col, FLexer.Filename])); + Hi := ParseIntLiteral(FCurrent.Value); + if Neg then Hi := -Hi; + Advance(); + if Hi < Lo then + raise EParseError.Create(Format( + 'Subrange %d..%d is descending at line %d col %d in %s', + [Lo, Hi, FCurrent.Line, FCurrent.Col, FLexer.Filename])); + { Pick the narrowest standard type covering [Lo, Hi]. } + if Lo >= 0 then + begin + if Hi <= 255 then Result := 'Byte' + else if Hi <= 65535 then Result := 'Word' + else if Hi <= 4294967295 then Result := 'Cardinal' + else Result := 'UInt64'; + end + else + begin + { Blaise has no 8-bit signed alias name (no ShortInt), so the narrowest + signed alias target is SmallInt (16-bit). } + if (Lo >= -32768) and (Hi <= 32767) then Result := 'SmallInt' + else if (Lo >= -2147483648) and (Hi <= 2147483647) then Result := 'Integer' + else Result := 'Int64'; + end; +end; + function TParser.ParseAnonEnumName: string; begin { Encode an inline '(a, b, c)' enumeration as the literal text '(a,b,c)' @@ -784,6 +850,17 @@ begin TD.Def := ParseSetDef() else if Check(tkFunction) or Check(tkProcedure) then TD.Def := ParseProceduralTypeDef() + else if (Check(tkIntLit) or Check(tkMinus)) and SubrangeAhead() then + begin + { Named integer subrange: type TByte = 0..255; type TIdx = -10..10; + Blaise does not range-check, so a subrange is an alias to the + narrowest standard integer type that holds both bounds. This keeps + record/array layout correct (TByte is byte-sized) while the value + behaves as an ordinary integer. } + AD := TTypeAliasDef.Create(); + AD.TypeName := Self.ParseIntegerSubrangeBaseType(); + TD.Def := AD; + end else if Check(tkArray) or Check(tkCaret) or Check(tkIdent) then begin { Array alias: type TArr = array[L..H] of T; @@ -795,7 +872,7 @@ begin end else raise EParseError.Create(Format( - 'Expected ''record'', ''class'', ''interface'', ''('', ''set'', ''function'', ''procedure'', or type name at line %d col %d in %s', + 'Expected ''record'', ''class'', ''interface'', ''('', ''set'', ''function'', ''procedure'', subrange, or type name at line %d col %d in %s', [FCurrent.Line, FCurrent.Col, FLexer.Filename])); end; Expect(tkSemicolon); diff --git a/compiler/src/test/pascal/cp.test.e2e.misc.pas b/compiler/src/test/pascal/cp.test.e2e.misc.pas index 146ae5e..999fc37 100644 --- a/compiler/src/test/pascal/cp.test.e2e.misc.pas +++ b/compiler/src/test/pascal/cp.test.e2e.misc.pas @@ -112,6 +112,12 @@ type { Nested generic type arguments: TList>. Was a parser gap (type-arg list did not recurse, in both type and constructor position). } procedure TestRun_NestedGenericTypeArgs; + + { Named integer subrange type (issue #130 bug1): the type-decl parser had + no integer-literal subrange case. A named subrange aliases the narrowest + standard integer type and carries no range checking. } + procedure TestRun_Subrange_NamedType; + procedure TestRun_Subrange_InRecordAndArray; end; implementation @@ -1177,6 +1183,43 @@ begin AssertRunsOnAll(SrcNestedGeneric, '7' + LE, 0); end; +procedure TE2EMiscTests.TestRun_Subrange_NamedType; +const + Src = ''' + program P; + type TByte = 0..255; + var b: TByte; + begin b := 5; WriteLn(b) end. + '''; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(Src, '5' + LE, 0); +end; + +procedure TE2EMiscTests.TestRun_Subrange_InRecordAndArray; +const + { A subrange as a record field and as an array element type, plus a negative + subrange — exercises that the aliased base type sizes layout correctly. } + Src = ''' + program P; + type + TByte = 0..255; + TIdx = -10..10; + TRec = record b: TByte; i: TIdx; end; + var + r: TRec; + a: array[0..2] of TByte; + begin + r.b := 200; r.i := -7; + a[0] := 1; a[1] := 250; a[2] := 99; + WriteLn(r.b, ' ', r.i, ' ', a[1]) + end. + '''; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(Src, '200 -7 250' + LE, 0); +end; + initialization RegisterTest(TE2EMiscTests); diff --git a/compiler/src/test/pascal/cp.test.parser.pas b/compiler/src/test/pascal/cp.test.parser.pas index 38f6991..b85a418 100644 --- a/compiler/src/test/pascal/cp.test.parser.pas +++ b/compiler/src/test/pascal/cp.test.parser.pas @@ -54,6 +54,11 @@ type procedure TestChain_MethodThenMethodThenField; procedure TestChain_FuncCallThenSubscript; + { Named integer subrange types (issue #130 bug1) } + procedure TestSubrange_NamedType_Parses; + procedure TestSubrange_NegativeBounds_Parses; + procedure TestSubrange_Descending_Error; + { Error cases } procedure TestError_MissingProgramKeyword; procedure TestError_MissingDot; @@ -527,6 +532,29 @@ begin end; end; +procedure TParserTests.TestSubrange_NamedType_Parses; +begin + { type TByte = 0..255; must parse (issue #130 bug1). } + ParseSource('program P; type TByte = 0..255; var b: TByte; ' + + 'begin b := 5 end.').Free(); +end; + +procedure TParserTests.TestSubrange_NegativeBounds_Parses; +begin + ParseSource('program P; type TIdx = -10..10; var i: TIdx; ' + + 'begin i := -3 end.').Free(); +end; + +procedure TParserTests.TestSubrange_Descending_Error; +begin + try + ParseSource('program P; type TBad = 10..0; begin end.').Free(); + Fail('Expected EParseError for descending subrange'); + except + on E: EParseError do ; { expected } + end; +end; + initialization RegisterTest(TParserTests); diff --git a/docs/grammar.ebnf b/docs/grammar.ebnf index ebf6a27..80a84b9 100644 --- a/docs/grammar.ebnf +++ b/docs/grammar.ebnf @@ -237,9 +237,21 @@ TypeDef | EnumDef | SetType | ProceduralType + | IntSubrange (* named integer subrange, e.g. TByte = 0..255 *) | TypeName (* covers ArrayType, pointer alias ^T, simple alias, metaclass *) ; +IntSubrange + = [ MINUS ] INT_LIT DOTDOT [ MINUS ] INT_LIT + ; + +(* A named integer subrange is an alias to the narrowest STANDARD integer type + * that holds both bounds (0..255 -> Byte, -10..10 -> ShortInt, etc.). Blaise + * does not range-check, so the subrange carries no run-time bound enforcement; + * the base-type choice exists only to keep record/array element layout correct. + * Only integer-literal bounds are accepted as a named type; identifier- or + * enum-bounded subranges (TLow..THigh, red..blue) are not a named-type form. *) + RecordDef = [ PACKED ] RECORD { FieldDecl | MethodDecl } END ;