These restriction pragmas are not yet supported on FSF GNAT 5: No_Specification_Of_Aspect No_Use_Of_Attribute No_Use_Of_Pragma --- gnat/targparm.ads.orig 2015-05-06 11:08:38 UTC +++ gnat/targparm.ads @@ -615,53 +615,28 @@ package Targparm is -- selected component with Sloc value System_Location and given Prefix -- (Pre) and Selector (Sel) values. - type Set_NOD_Type is access procedure (Unit : Node_Id); + type Set_RND_Type is access procedure (Unit : Node_Id); -- Parameter type for Get_Target_Parameters that records a Restriction -- No_Dependence for the given unit (identifier or selected component). - type Set_NSA_Type is access procedure (Asp : Name_Id; OK : out Boolean); - -- Parameter type for Get_Target_Parameters that records a Restriction - -- No_Specification_Of_Aspect. Asp is the aspect name. OK is set True - -- if this is an OK aspect name, and False if it is not an aspect name. - - type Set_NUA_Type is access procedure (Attr : Name_Id; OK : out Boolean); - -- Parameter type for Get_Target_Parameters that records a Restriction - -- No_Use_Of_Attribute. Attr is the attribute name. OK is set True if - -- this is an OK attribute name, and False if it is not an attribute name. - - type Set_NUP_Type is access procedure (Prag : Name_Id; OK : out Boolean); - -- Parameter type for Get_Target_Parameters that records a Restriction - -- No_Use_Of_Pragma. Prag is the pragma name. OK is set True if this is - -- an OK pragma name, and False if it is not a recognized pragma name. - procedure Get_Target_Parameters (System_Text : Source_Buffer_Ptr; Source_First : Source_Ptr; Source_Last : Source_Ptr; Make_Id : Make_Id_Type := null; Make_SC : Make_SC_Type := null; - Set_NOD : Set_NOD_Type := null; - Set_NSA : Set_NSA_Type := null; - Set_NUA : Set_NUA_Type := null; - Set_NUP : Set_NUP_Type := null); - -- Called at the start of execution to obtain target parameters from the - -- source of package System. The parameters provide the source text to be - -- scanned (in System_Text (Source_First .. Source_Last)). If the three - -- subprograms Make_Id, Make_SC, and Set_NOD are left at their default - -- value of null, Get_Target_Parameters will ignore pragma Restrictions - -- (No_Dependence) lines; otherwise it will use these three subprograms to - -- record them. Similarly, if Set_NUP is left at its default value of null, - -- then any occurrences of pragma Restrictions (No_Use_Of_Pragma => XXX) - -- will be ignored; otherwise it will use this procedure to record the - -- pragma. Similarly for the NSA and NUA cases. + Set_RND : Set_RND_Type := null); + -- Called at the start of execution to obtain target parameters from + -- the source of package System. The parameters provide the source + -- text to be scanned (in System_Text (Source_First .. Source_Last)). + -- if the three subprograms are left at their default value of null, + -- Get_Target_Parameters will ignore pragma Restrictions No_Dependence + -- lines, otherwise it will use these three subprograms to record them. procedure Get_Target_Parameters (Make_Id : Make_Id_Type := null; Make_SC : Make_SC_Type := null; - Set_NOD : Set_NOD_Type := null; - Set_NSA : Set_NSA_Type := null; - Set_NUA : Set_NUA_Type := null; - Set_NUP : Set_NUP_Type := null); + Set_RND : Set_RND_Type := null); -- This version reads in system.ads using Osint. The idea is that the -- caller uses the first version if they have to read system.ads anyway -- (e.g. the compiler) and uses this simpler interface if system.ads is --- gnat/targparm.adb.orig 2015-05-06 11:08:38 UTC +++ gnat/targparm.adb @@ -154,10 +154,7 @@ package body Targparm is procedure Get_Target_Parameters (Make_Id : Make_Id_Type := null; Make_SC : Make_SC_Type := null; - Set_NOD : Set_NOD_Type := null; - Set_NSA : Set_NSA_Type := null; - Set_NUA : Set_NUA_Type := null; - Set_NUP : Set_NUP_Type := null) + Set_RND : Set_RND_Type := null) is Text : Source_Buffer_Ptr; Hi : Source_Ptr; @@ -184,10 +181,7 @@ package body Targparm is Source_Last => Hi, Make_Id => Make_Id, Make_SC => Make_SC, - Set_NOD => Set_NOD, - Set_NSA => Set_NSA, - Set_NUA => Set_NUA, - Set_NUP => Set_NUP); + Set_RND => Set_RND); end Get_Target_Parameters; -- Version where caller supplies system.ads text @@ -198,10 +192,7 @@ package body Targparm is Source_Last : Source_Ptr; Make_Id : Make_Id_Type := null; Make_SC : Make_SC_Type := null; - Set_NOD : Set_NOD_Type := null; - Set_NSA : Set_NSA_Type := null; - Set_NUA : Set_NUA_Type := null; - Set_NUP : Set_NUP_Type := null) + Set_RND : Set_RND_Type := null) is P : Source_Ptr; -- Scans source buffer containing source of system.ads @@ -212,48 +203,6 @@ package body Targparm is Result : Boolean; -- Records boolean from system line - OK : Boolean; - -- Status result from Set_NUP/NSA/NUA call - - PR_Start : Source_Ptr; - -- Pointer to ( following pragma Restrictions - - procedure Collect_Name; - -- Scan a name starting at System_Text (P), and put Name in Name_Buffer, - -- with Name_Len being length, folded to lower case. On return, P points - -- just past the last character (which should be a right paren). - - ------------------ - -- Collect_Name -- - ------------------ - - procedure Collect_Name is - begin - Name_Len := 0; - loop - if System_Text (P) in 'a' .. 'z' - or else - System_Text (P) = '_' - or else - System_Text (P) in '0' .. '9' - then - Name_Buffer (Name_Len + 1) := System_Text (P); - - elsif System_Text (P) in 'A' .. 'Z' then - Name_Buffer (Name_Len + 1) := - Character'Val (Character'Pos (System_Text (P)) + 32); - - else - exit; - end if; - - P := P + 1; - Name_Len := Name_Len + 1; - end loop; - end Collect_Name; - - -- Start of processing for Get_Target_Parameters - begin if Parameters_Obtained then return; @@ -312,9 +261,6 @@ package body Targparm is elsif System_Text (P .. P + 20) = "pragma Restrictions (" then P := P + 21; - PR_Start := P - 1; - - -- Boolean restrictions Rloop : for K in All_Boolean_Restrictions loop declare @@ -339,9 +285,7 @@ package body Targparm is null; end loop Rloop; - -- Restrictions taking integer parameter - - Ploop : for K in Integer_Parameter_Restrictions loop + Ploop : for K in All_Parameter_Restrictions loop declare Rname : constant String := All_Parameter_Restrictions'Image (K); @@ -456,119 +400,23 @@ package body Targparm is P := P + 1; end loop; - Set_NOD (Unit); + Set_RND (Unit); goto Line_Loop_Continue; end; - - -- No_Specification_Of_Aspect case - - elsif System_Text (P .. P + 29) = "No_Specification_Of_Aspect => " - then - P := P + 30; - - -- Skip this processing (and simply ignore the pragma), if - -- caller did not supply the subprogram we need to process - -- such lines. - - if Set_NSA = null then - goto Line_Loop_Continue; - end if; - - -- We have scanned - -- "pragma Restrictions (No_Specification_Of_Aspect =>" - - Collect_Name; - - if System_Text (P) /= ')' then - goto Bad_Restrictions_Pragma; - - else - Set_NSA (Name_Find, OK); - - if OK then - goto Line_Loop_Continue; - else - goto Bad_Restrictions_Pragma; - end if; - end if; - - -- No_Use_Of_Attribute case - - elsif System_Text (P .. P + 22) = "No_Use_Of_Attribute => " then - P := P + 23; - - -- Skip this processing (and simply ignore No_Use_Of_Attribute - -- lines) if caller did not supply the subprogram we need to - -- process such lines. - - if Set_NUA = null then - goto Line_Loop_Continue; - end if; - - -- We have scanned - -- "pragma Restrictions (No_Use_Of_Attribute =>" - - Collect_Name; - - if System_Text (P) /= ')' then - goto Bad_Restrictions_Pragma; - - else - Set_NUA (Name_Find, OK); - - if OK then - goto Line_Loop_Continue; - else - goto Bad_Restrictions_Pragma; - end if; - end if; - - -- No_Use_Of_Pragma case - - elsif System_Text (P .. P + 19) = "No_Use_Of_Pragma => " then - P := P + 20; - - -- Skip this processing (and simply ignore No_Use_Of_Pragma - -- lines) if caller did not supply the subprogram we need to - -- process such lines. - - if Set_NUP = null then - goto Line_Loop_Continue; - end if; - - -- We have scanned - -- "pragma Restrictions (No_Use_Of_Pragma =>" - - Collect_Name; - - if System_Text (P) /= ')' then - goto Bad_Restrictions_Pragma; - - else - Set_NUP (Name_Find, OK); - - if OK then - goto Line_Loop_Continue; - else - goto Bad_Restrictions_Pragma; - end if; - end if; end if; -- Here if unrecognizable restrictions pragma form - <> - Set_Standard_Error; Write_Line ("fatal error: system.ads is incorrectly formatted"); Write_Str ("unrecognized or incorrect restrictions pragma: "); - P := PR_Start; + while System_Text (P) /= ')' + and then + System_Text (P) /= ASCII.LF loop - exit when System_Text (P) = ASCII.LF; Write_Char (System_Text (P)); - exit when System_Text (P) = ')'; P := P + 1; end loop;