From 05c9f8b4ce1ccfe2b4fe1b41ea78cf73af79fbac Mon Sep 17 00:00:00 2001 From: "Kevin Ransom (msft)" Date: Fri, 22 May 2020 10:16:26 -0700 Subject: [PATCH] Ensure that scripts without the notion of upper/lower case can create du identifiers (#9199) * Ensure that scripts without the notion of upper/lower case can create du identifiers * Feedback and improvements * feedback * correct comment --- src/absil/illib.fs | 17 ++++++++++++++--- src/fsharp/TypeChecker.fs | 6 +++--- src/fsharp/pars.fsy | 6 +++--- .../PatternMatching/Named/E_ActivePatterns01.fs | 14 ++++++++------ .../PatternMatching/Named/discUnion01.fs | 6 +++--- tests/fsharpqa/Source/Globalization/Hindi.fs | 4 ++-- 6 files changed, 33 insertions(+), 20 deletions(-) diff --git a/src/absil/illib.fs b/src/absil/illib.fs index ef71ec8df..98a863699 100644 --- a/src/absil/illib.fs +++ b/src/absil/illib.fs @@ -503,9 +503,20 @@ module String = let uppercase (s: string) = s.ToUpperInvariant() - let isUpper (s: string) = - s.Length >= 1 && Char.IsUpper s.[0] && not (Char.IsLower s.[0]) - + // Scripts that distinguish between upper and lower case (bicameral) DU Discriminators and Active Pattern identifiers are required to start with an upper case character. + // For valid identifiers where the case of the identifier can not be determined because there is no upper and lower case we will allow DU Discriminators and upper case characters + // to be used. This means that developers using unicameral scripts such as hindi, are not required to prefix these identifiers with an Upper case latin character. + // + let isLeadingIdentifierCharacterUpperCase (s:string) = + let isUpperCaseCharacter c = + // if IsUpper and IsLower return the same value, then we can't tell if it's upper or lower case, so ensure it is a letter + // otherwise it is bicameral, so must be upper case + let isUpper = Char.IsUpper c + if isUpper = Char.IsLower c then Char.IsLetter c + else isUpper + + s.Length >= 1 && isUpperCaseCharacter s.[0] + let capitalize (s: string) = if s.Length = 0 then s else uppercase s.[0..0] + s.[ 1.. s.Length - 1 ] diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 2cb72a304..a61a719d7 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -5233,7 +5233,7 @@ and TcPatBindingName cenv env id ty isMemberThis vis1 topValData (inlineFlag, de let name = id.idText match values.TryGetValue name with | true, value -> - if not (String.IsNullOrEmpty name) && Char.IsLower(name.[0]) then + if not (String.IsNullOrEmpty name) && not (String.isLeadingIdentifierCharacterUpperCase name) then match env.eNameResEnv.ePatItems.TryGetValue name with | true, Item.Value vref when vref.LiteralValue.IsSome -> warning(Error(FSComp.SR.checkLowercaseLiteralBindingInPattern name, id.idRange)) @@ -12775,7 +12775,7 @@ module TcRecdUnionAndEnumDeclarations = begin errorR(Error(FSComp.SR.tcUnionCaseNameConflictsWithGeneratedType(name, "Tags"), id.idRange)) CheckNamespaceModuleOrTypeName cenv.g id - if not (String.isUpper name) && name <> opNameCons && name <> opNameNil then + if not (String.isLeadingIdentifierCharacterUpperCase name) && name <> opNameCons && name <> opNameNil then errorR(NotUpperCaseConstructor(id.idRange)) let ValidateFieldNames (synFields: SynField list, tastFields: RecdField list) = @@ -15174,7 +15174,7 @@ module TcExceptionDeclarations = let TcExnDefnCore_Phase1A cenv env parent (SynExceptionDefnRepr(Attributes synAttrs, UnionCase(_, id, _, _, _, _), _, doc, vis, m)) = let attrs = TcAttributes cenv env AttributeTargets.ExnDecl synAttrs - if not (String.isUpper id.idText) then errorR(NotUpperCaseConstructor m) + if not (String.isLeadingIdentifierCharacterUpperCase id.idText) then errorR(NotUpperCaseConstructor m) let vis, cpath = ComputeAccessAndCompPath env None m vis None parent let vis = TcRecdUnionAndEnumDeclarations.CombineReprAccess parent vis CheckForDuplicateConcreteType env (id.idText + "Exception") id.idRange diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index 2c4d456aa..034ec5ec5 100644 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -3050,7 +3050,7 @@ atomicPattern: | atomicPatternLongIdent %prec prec_atompat_pathop { let vis, lidwd = $1 - if not (isNilOrSingleton lidwd.Lid) || (let c = (List.head lidwd.Lid).idText.[0] in Char.IsUpper(c) && not (Char.IsLower c)) + if not (isNilOrSingleton lidwd.Lid) || String.isLeadingIdentifierCharacterUpperCase (List.head lidwd.Lid).idText then mkSynPatMaybeVar lidwd vis (lhs parseState) else mkSynPatVar vis (List.head lidwd.Lid) } @@ -5293,8 +5293,8 @@ operatorName: /* One part of an active pattern name */ activePatternCaseName: - | IDENT - { if not (String.isUpper $1) then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsActivePatternCaseMustBeginWithUpperCase()); + | IDENT + { if not (String.isLeadingIdentifierCharacterUpperCase _1) then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsActivePatternCaseMustBeginWithUpperCase()); if ($1.IndexOf('|') <> -1) then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsActivePatternCaseContainsPipe()); $1 } diff --git a/tests/fsharpqa/Source/Conformance/PatternMatching/Named/E_ActivePatterns01.fs b/tests/fsharpqa/Source/Conformance/PatternMatching/Named/E_ActivePatterns01.fs index c2cb38237..19bf8faee 100644 --- a/tests/fsharpqa/Source/Conformance/PatternMatching/Named/E_ActivePatterns01.fs +++ b/tests/fsharpqa/Source/Conformance/PatternMatching/Named/E_ActivePatterns01.fs @@ -1,12 +1,13 @@ // #Regression #Conformance #PatternMatching #ActivePatterns // Verify error if Active Patterns do not start with an upper case letter -//Active pattern case identifiers must begin with an uppercase letter -//Active pattern case identifiers must begin with an uppercase letter //Active pattern case identifiers must begin with an uppercase letter -//Active pattern case identifiers must begin with an uppercase letter -//Active pattern case identifiers must begin with an uppercase letter -//The '\|' character is not permitted in active pattern case identifiers -//The '\|' character is not permitted in active pattern case identifiers +//Active pattern case identifiers must begin with an uppercase letter +//Active pattern case identifiers must begin with an uppercase letter +//Active pattern case identifiers must begin with an uppercase letter +//Active pattern case identifiers must begin with an uppercase letter +//The '\|' character is not permitted in active pattern case identifiers +//The '\|' character is not permitted in active pattern case identifiers +//Active pattern case identifiers must begin with an uppercase letter let (|positive|negative|) n = if n < 0 then positive else negative let (|`` A``|) (x:int) = x @@ -14,5 +15,6 @@ let (|B1|``+B2``|) (x:int) = if x = 0 then OneA else ``+B2`` let (|`` C``|_|) (x:int) = if x = 0 then Some(x) else None let (|``D|E``|F|) (x:int) = if x = 0 then D elif x = 1 then E else F let (|G|``H||I``|) (x:int) = if x = 0 then G elif x = 1 then H else ``|I`` +let (|_J|) (x:int) = _J exit 1 diff --git a/tests/fsharpqa/Source/Conformance/PatternMatching/Named/discUnion01.fs b/tests/fsharpqa/Source/Conformance/PatternMatching/Named/discUnion01.fs index 89832cc91..c1a896978 100644 --- a/tests/fsharpqa/Source/Conformance/PatternMatching/Named/discUnion01.fs +++ b/tests/fsharpqa/Source/Conformance/PatternMatching/Named/discUnion01.fs @@ -6,17 +6,17 @@ type Foo = | A of int | B of string * int - + let test x = match x with | A(1) | B(_,1) -> 1 | A(2) | B(_,2) -> 2 | B(_, _) -> -1 | A(_) -> -2 - + if test (A(1)) <> 1 then exit 1 if test (B("",1)) <> 1 then exit 1 - + if test (A(2)) <> 2 then exit 1 if test (B("",2)) <> 2 then exit 1 diff --git a/tests/fsharpqa/Source/Globalization/Hindi.fs b/tests/fsharpqa/Source/Globalization/Hindi.fs index 3c041c812..63a33edbd 100644 --- a/tests/fsharpqa/Source/Globalization/Hindi.fs +++ b/tests/fsharpqa/Source/Globalization/Hindi.fs @@ -14,8 +14,8 @@ module पिछले = // DU type ख़तरxनाक = - | Uअलगाववादी // There's no uppercase/lowercase in Hindi, so I'm adding a latin char - | Aमिलती of ख़तरनाक + | अलगाववादी // There's no uppercase/lowercase in Hindi, ensure that a Hindi character will suffice to start the DU case name + | मिलती of ख़तरनाक | X // Record -- GitLab