diff options
| author | Steve Baird <baird@adacore.com> | 2020-04-03 17:34:38 -0700 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-06-16 09:07:15 -0400 |
| commit | 158b52c9616a3bc0b1c2622e3627a544318fd329 (patch) | |
| tree | 709b9976644cf03e951725847b9157d209ef0d1b /gcc/ada/sem_util.adb | |
| parent | 51e2de474edf2be4997862eb878a5abf5b2a323b (diff) | |
| download | gcc-158b52c9616a3bc0b1c2622e3627a544318fd329.zip gcc-158b52c9616a3bc0b1c2622e3627a544318fd329.tar.gz gcc-158b52c9616a3bc0b1c2622e3627a544318fd329.tar.bz2 | |
[Ada] Implement AI12-0249, AI12-0295 (user-defined numeric & string literals)
2020-06-16 Steve Baird <baird@adacore.com>
gcc/ada/
* snames.ads-tmpl: Define names of the three new aspects.
* aspects.ads: Define the three new aspects.
* sem_util.ads, sem_util.adb, sem_dim.adb: Move the function
String_From_Numeric_Literal from being declared in the body of
package Sem_Dim to being declared in the visible part of package
Sem_Util.
* sem_ch13.ads, sem_ch13.adb: Declare new visible procedure
Validate_Literal_Aspect. This is where most of the legality
checking occurs for an aspect specification for one of the three
new aspects, as well as resolution of the subprogram named in
the aspect specification. Follow example of other aspects (e.g.,
Validate_Literal_Aspect is called in much the same way as
Validate_Iterable_Aspect in Analyze_Aspects_At_Freeze_Point; a
small amount of legality checking is performed in
Analyze_One_Aspect in much the same way as for Default_Value or
Default_Component_Value aspects). Most of the work is done in
Validate_Literal_Aspect.
* contracts.adb (Add_Contract_Item): Call
Validate_Literal_Aspect in much the same way that
Validate_Iterable_Aspect was already being called.
* sem_res.adb (Resolve): Rewrite a literal as a call if it is a
user-defined literal. This is where the dynamic semantics of
the 3 new aspects are implemented.
* sem_ch6.adb (Fully_Conformant_Expressions): Two numeric
literals that have different text but the same value (e.g.,
12345 and 12_345) do not conform if they are user-defined
literals. Introduce a new function
User_Defined_Numeric_Literal_Mismatch to avoid duplication in
making this check.
* sem_type.adb (Has_Compatible_Type): A numeric literal can be
compatible with a non-numeric type (and a string literal can be
compatible with a non-string type) if it can be interpreted as a
user-defined literal.
Diffstat (limited to 'gcc/ada/sem_util.adb')
| -rw-r--r-- | gcc/ada/sem_util.adb | 57 |
1 files changed, 57 insertions, 0 deletions
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 366eaff..43bffc9 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -26720,6 +26720,63 @@ package body Sem_Util is return Statically_Names_Object (Prefix (N)); end Statically_Names_Object; + --------------------------------- + -- String_From_Numeric_Literal -- + --------------------------------- + + function String_From_Numeric_Literal (N : Node_Id) return String_Id is + Loc : constant Source_Ptr := Sloc (N); + Sbuffer : constant Source_Buffer_Ptr := + Source_Text (Get_Source_File_Index (Loc)); + Src_Ptr : Source_Ptr := Loc; + + C : Character := Sbuffer (Src_Ptr); + -- Current source program character + + function Belongs_To_Numeric_Literal (C : Character) return Boolean; + -- Return True if C belongs to the numeric literal + + -------------------------------- + -- Belongs_To_Numeric_Literal -- + -------------------------------- + + function Belongs_To_Numeric_Literal (C : Character) return Boolean is + begin + case C is + when '0' .. '9' + | '_' | '.' | 'e' | '#' | 'A' | 'B' | 'C' | 'D' | 'E' | 'F' + => + return True; + + -- Make sure '+' or '-' is part of an exponent + + when '+' | '-' => + declare + Prev_C : constant Character := Sbuffer (Src_Ptr - 1); + begin + return Prev_C = 'e' or else Prev_C = 'E'; + end; + + -- Other characters cannot belong to a numeric literal + + when others => + return False; + end case; + end Belongs_To_Numeric_Literal; + + -- Start of processing for String_From_Numeric_Literal + + begin + Start_String; + while Belongs_To_Numeric_Literal (C) loop + Store_String_Char (C); + Src_Ptr := Src_Ptr + 1; + C := Sbuffer (Src_Ptr); + end loop; + + return End_String; + end String_From_Numeric_Literal; + -------------------------------------- -- Subject_To_Loop_Entry_Attributes -- -------------------------------------- |