From 1a14bfbd78324a25943998ed1e877e41ec4cd417 Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Wed, 11 Dec 2019 10:21:57 +0100 Subject: [PATCH] [Ada] Change pragma Compile_Time_Error to force compile-time evaluation 2020-05-25 Yannick Moy gcc/ada/ * doc/gnat_rm/implementation_defined_pragmas.rst: Document changes to pragmas Compile_Time_Error/Compile_Time_Warning. * gnat_rm.texi: Regenerate. * libgnat/g-bytswa.adb: Change uses of Compile_Time_Error to Compile_Time_Warning, as the actual expression may not always be known statically. * sem_prag.adb (Analyze_Pragma): Handle differently pragma Compile_Time_Error in both compilation and in GNATprove mode. (Validate_Compile_Time_Warning_Or_Error): Issue an error or warning when the expression is not known at compile time. * usage.adb: Add missing documentation for warning switches _c and _r. * warnsw.ads: Update comment. --- gcc/ada/ChangeLog | 16 +++++ .../implementation_defined_pragmas.rst | 11 +-- gcc/ada/gnat_rm.texi | 13 ++-- gcc/ada/libgnat/g-bytswa.adb | 6 +- gcc/ada/sem_prag.adb | 72 +++++++++++++++---- gcc/ada/usage.adb | 6 ++ gcc/ada/warnsw.ads | 4 +- 7 files changed, 99 insertions(+), 29 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 08c26768ccc..7c8af5f8387 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2020-05-25 Yannick Moy + + * doc/gnat_rm/implementation_defined_pragmas.rst: Document + changes to pragmas Compile_Time_Error/Compile_Time_Warning. + * gnat_rm.texi: Regenerate. + * libgnat/g-bytswa.adb: Change uses of Compile_Time_Error to + Compile_Time_Warning, as the actual expression may not always be + known statically. + * sem_prag.adb (Analyze_Pragma): Handle differently pragma + Compile_Time_Error in both compilation and in GNATprove mode. + (Validate_Compile_Time_Warning_Or_Error): Issue an error or + warning when the expression is not known at compile time. + * usage.adb: Add missing documentation for warning switches _c + and _r. + * warnsw.ads: Update comment. + 2020-05-25 Justin Squirek * sem_ch6.adb (Check_Return_Obj_Accessibility): Use original diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst index c3d6f90714c..471bfdc2e37 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst @@ -1094,14 +1094,14 @@ This pragma can be used to generate additional compile time error messages. It is particularly useful in generics, where errors can be issued for specific problematic instantiations. The first parameter is a boolean -expression. The pragma is effective only if the value of this expression -is known at compile time, and has the value True. The set of expressions +expression. The pragma ensures that the value of an expression +is known at compile time, and has the value False. The set of expressions whose values are known at compile time includes all static boolean expressions, and also other values which the compiler can determine at compile time (e.g., the size of a record type set by an explicit size representation clause, or the value of a variable which was initialized to a constant and is known not to have been modified). -If these conditions are met, an error message is generated using +If these conditions are not met, an error message is generated using the value given as the second argument. This string value may contain embedded ASCII.LF characters to break the message into multiple lines. @@ -1118,7 +1118,10 @@ Syntax: Same as pragma Compile_Time_Error, except a warning is issued instead -of an error message. Note that if this pragma is used in a package that +of an error message. If switch *-gnatw_C* is used, a warning is only issued +if the value of the expression is known to be True at compile time, not when +the value of the expression is not known at compile time. +Note that if this pragma is used in a package that is with'ed by a client, the client will get the warning even though it is issued by a with'ed package (normally warnings in with'ed units are suppressed, but this is a special exception to that rule). diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index bd9c86e5c18..d616ca9bb5b 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -21,7 +21,7 @@ @copying @quotation -GNAT Reference Manual , Dec 10, 2019 +GNAT Reference Manual , May 04, 2020 AdaCore @@ -2492,14 +2492,14 @@ This pragma can be used to generate additional compile time error messages. It is particularly useful in generics, where errors can be issued for specific problematic instantiations. The first parameter is a boolean -expression. The pragma is effective only if the value of this expression -is known at compile time, and has the value True. The set of expressions +expression. The pragma ensures that the value of an expression +is known at compile time, and has the value False. The set of expressions whose values are known at compile time includes all static boolean expressions, and also other values which the compiler can determine at compile time (e.g., the size of a record type set by an explicit size representation clause, or the value of a variable which was initialized to a constant and is known not to have been modified). -If these conditions are met, an error message is generated using +If these conditions are not met, an error message is generated using the value given as the second argument. This string value may contain embedded ASCII.LF characters to break the message into multiple lines. @@ -2516,7 +2516,10 @@ pragma Compile_Time_Warning @end example Same as pragma Compile_Time_Error, except a warning is issued instead -of an error message. Note that if this pragma is used in a package that +of an error message. If switch @emph{-gnatw_C} is used, a warning is only issued +if the value of the expression is known to be True at compile time, not when +the value of the expression is not known at compile time. +Note that if this pragma is used in a package that is with'ed by a client, the client will get the warning even though it is issued by a with'ed package (normally warnings in with'ed units are suppressed, but this is a special exception to that rule). diff --git a/gcc/ada/libgnat/g-bytswa.adb b/gcc/ada/libgnat/g-bytswa.adb index e915e58d428..abcfe779abe 100644 --- a/gcc/ada/libgnat/g-bytswa.adb +++ b/gcc/ada/libgnat/g-bytswa.adb @@ -45,7 +45,7 @@ package body GNAT.Byte_Swapping is function Swapped2 (Input : Item) return Item is function As_U16 is new Unchecked_Conversion (Item, U16); function As_Item is new Unchecked_Conversion (U16, Item); - pragma Compile_Time_Error (Item'Max_Size_In_Storage_Elements /= 2, + pragma Compile_Time_Warning (Item'Max_Size_In_Storage_Elements /= 2, "storage size must be 2 bytes"); begin return As_Item (Bswap_16 (As_U16 (Input))); @@ -58,7 +58,7 @@ package body GNAT.Byte_Swapping is function Swapped4 (Input : Item) return Item is function As_U32 is new Unchecked_Conversion (Item, U32); function As_Item is new Unchecked_Conversion (U32, Item); - pragma Compile_Time_Error (Item'Max_Size_In_Storage_Elements /= 4, + pragma Compile_Time_Warning (Item'Max_Size_In_Storage_Elements /= 4, "storage size must be 4 bytes"); begin return As_Item (Bswap_32 (As_U32 (Input))); @@ -71,7 +71,7 @@ package body GNAT.Byte_Swapping is function Swapped8 (Input : Item) return Item is function As_U64 is new Unchecked_Conversion (Item, U64); function As_Item is new Unchecked_Conversion (U64, Item); - pragma Compile_Time_Error (Item'Max_Size_In_Storage_Elements /= 8, + pragma Compile_Time_Warning (Item'Max_Size_In_Storage_Elements /= 8, "storage size must be 8 bytes"); begin return As_Item (Bswap_64 (As_U64 (Input))); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 2369d64f732..936d699a8b7 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -7750,23 +7750,60 @@ package body Sem_Prag is procedure Process_Compile_Time_Warning_Or_Error is P : Node_Id := Parent (N); Arg1x : constant Node_Id := Get_Pragma_Arg (Arg1); + begin - -- In GNATprove mode, pragmas Compile_Time_Error and + Check_Arg_Count (2); + Check_No_Identifiers; + Check_Arg_Is_OK_Static_Expression (Arg2, Standard_String); + Analyze_And_Resolve (Arg1x, Standard_Boolean); + + -- In GNATprove mode, pragma Compile_Time_Error is translated as + -- a Check pragma in GNATprove mode, handled as an assumption in + -- GNATprove. This is correct as the compiler will issue an error + -- if the condition cannot be statically evaluated to False. -- Compile_Time_Warning are ignored, as the analyzer may not have the -- same information as the compiler (in particular regarding size of - -- objects decided in gigi) so it makes no sense to issue an error or - -- warning in GNATprove. + -- objects decided in gigi) so it makes no sense to issue a warning + -- in GNATprove. if GNATprove_Mode then - Rewrite (N, Make_Null_Statement (Loc)); + if Prag_Id = Pragma_Compile_Time_Error then + declare + New_Args : List_Id; + begin + -- Implement Compile_Time_Error by generating + -- a corresponding Check pragma: + + -- pragma Check (name, condition); + + -- where name is the identifier matching the pragma name. So + -- rewrite pragma in this manner and analyze the result. + + New_Args := New_List + (Make_Pragma_Argument_Association + (Loc, + Expression => Make_Identifier (Loc, Pname)), + Make_Pragma_Argument_Association + (Sloc (Arg1x), + Expression => Arg1x)); + + -- Rewrite as Check pragma + + Rewrite (N, + Make_Pragma (Loc, + Chars => Name_Check, + Pragma_Argument_Associations => New_Args)); + + Analyze (N); + end; + + else + Rewrite (N, Make_Null_Statement (Loc)); + end if; + return; end if; - Check_Arg_Count (2); - Check_No_Identifiers; - Check_Arg_Is_OK_Static_Expression (Arg2, Standard_String); - Analyze_And_Resolve (Arg1x, Standard_Boolean); - -- If the condition is known at compile time (now), validate it now. -- Otherwise, register the expression for validation after the back -- end has been called, because it might be known at compile time @@ -31687,6 +31724,9 @@ package body Sem_Prag is Arg1x : constant Node_Id := Get_Pragma_Arg (Arg1); Arg2 : constant Node_Id := Next (Arg1); + Pname : constant Name_Id := Pragma_Name_Unmapped (N); + Prag_Id : constant Pragma_Id := Get_Pragma_Id (Pname); + begin Analyze_And_Resolve (Arg1x, Standard_Boolean); @@ -31700,8 +31740,6 @@ package body Sem_Prag is declare Cent : constant Entity_Id := Cunit_Entity (Current_Sem_Unit); - Pname : constant Name_Id := Pragma_Name_Unmapped (N); - Prag_Id : constant Pragma_Id := Get_Pragma_Id (Pname); Str : constant String_Id := Strval (Expr_Value_S (Get_Pragma_Arg (Arg2))); Str_Len : constant Nat := String_Length (Str); @@ -31787,10 +31825,14 @@ package body Sem_Prag is end; end if; - -- Arg1x is not known at compile time, so issue a warning. This can - -- happen only if the pragma's processing was deferred until after the - -- back end is run (see Process_Compile_Time_Warning_Or_Error). - -- Note that the warning control switch applies to both pragmas. + -- Arg1x is not known at compile time, so possibly issue an error + -- or warning. This can happen only if the pragma's processing + -- was deferred until after the back end is run (see + -- Process_Compile_Time_Warning_Or_Error). Note that the warning + -- control switch applies to only the warning case. + + elsif Prag_Id = Pragma_Compile_Time_Error then + Error_Msg_N ("condition is not known at compile time", Arg1x); elsif Warn_On_Unknown_Compile_Time_Warning then Error_Msg_N ("?condition is not known at compile time", Arg1x); diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index fb261e5fbc0..0d1e1684eb7 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -495,6 +495,10 @@ begin Write_Line (" C* turn off warnings for constant conditional"); Write_Line (" .c+ turn on warnings for unrepped components"); Write_Line (" .C* turn off warnings for unrepped components"); + Write_Line (" _c* turn on warnings for unknown " & + "Compile_Time_Warning"); + Write_Line (" _C turn off warnings for unknown " & + "Compile_Time_Warning"); Write_Line (" d turn on warnings for implicit dereference"); Write_Line (" D* turn off warnings for implicit dereference"); Write_Line (" .d turn on tagging of warnings with -gnatw switch"); @@ -571,6 +575,8 @@ begin Write_Line (" R* turn off warnings for redundant construct"); Write_Line (" .r+ turn on warnings for object renaming function"); Write_Line (" .R* turn off warnings for object renaming function"); + Write_Line (" _r turn on warnings for components out of order"); + Write_Line (" _R turn off warnings for components out of order"); Write_Line (" s suppress all info/warnings"); Write_Line (" .s turn on warnings for overridden size clause"); Write_Line (" .S* turn off warnings for overridden size clause"); diff --git a/gcc/ada/warnsw.ads b/gcc/ada/warnsw.ads index c82f36d7431..abec8817cc9 100644 --- a/gcc/ada/warnsw.ads +++ b/gcc/ada/warnsw.ads @@ -49,8 +49,8 @@ package Warnsw is -- extensions. Warn_On_Unknown_Compile_Time_Warning : Boolean := True; - -- Warn on a pragma Compile_Time_Warning or Compile_Time_Error whose - -- condition has a value that is not known at compile time. + -- Warn on a pragma Compile_Time_Warning whose condition has a value that + -- is not known at compile time. Warn_On_Overridden_Size : Boolean := False; -- Warn when explicit record component clause or array component_size -- 2.30.2