diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 72 | ||||
| -rw-r--r-- | gcc/ada/ali.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/ali.ads | 11 | ||||
| -rw-r--r-- | gcc/ada/bcheck.adb | 70 | ||||
| -rw-r--r-- | gcc/ada/debug.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/einfo.adb | 33 | ||||
| -rw-r--r-- | gcc/ada/einfo.ads | 28 | ||||
| -rw-r--r-- | gcc/ada/fe.h | 4 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/g-socket.ads | 1 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/decl.c | 25 | ||||
| -rw-r--r-- | gcc/ada/lib-writ.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/opt.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/opt.ads | 16 | ||||
| -rw-r--r-- | gcc/ada/par-prag.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/prj-attr.ads | 3 | ||||
| -rw-r--r-- | gcc/ada/s-regpat.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 71 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 78 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 19 | ||||
| -rw-r--r-- | gcc/ada/sem_util.ads | 10 | ||||
| -rw-r--r-- | gcc/ada/snames.ads-tmpl | 2 | ||||
| -rw-r--r-- | gcc/ada/warnsw.adb | 1 |
26 files changed, 378 insertions, 142 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index af38910..9745330 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,75 @@ +2017-09-06 Eric Botcazou <ebotcazou@adacore.com> + + * ali.ads (ALIs_Record): Add No_Component_Reordering component. + (No_Component_Reordering_Specified): New switch. + * ali.adb (Initialize_ALI): Set No_Component_Reordering_Specified. + (Scan_ALI): Set No_Component_Reordering and deal with NC marker. + * bcheck.adb (Check_Consistent_No_Component_Reordering): + New check. + (Check_Configuration_Consistency): Invoke it. + * debug.adb (d.r): Toggle the effect of the switch. + (d.v): Change to no-op. + * einfo.ads (Has_Complex_Representation): + Restrict to record types. + (No_Reordering): New alias for Flag239. + (OK_To_Reorder_Components): Delete. + (No_Reordering): Declare. + (Set_No_Reordering): Likewise. + (OK_To_Reorder_Components): Delete. + (Set_OK_To_Reorder_Components): Likewise. + * einfo.adb (Has_Complex_Representation): Expect record types. + (No_Reordering): New function. + (OK_To_Reorder_Components): Delete. + (Set_Has_Complex_Representation): Expect base record types. + (Set_No_Reordering): New procedure. + (Set_OK_To_Reorder_Components): Delete. + (Write_Entity_Flags): Adjust to above change. + * fe.h (Debug_Flag_Dot_R): New macro and declaration. + * freeze.adb (Freeze_Record_Type): Remove conditional code setting + OK_To_Reorder_Components on record types with convention Ada. + * lib-writ.adb (Write_ALI): Deal with NC marker. + * opt.ads (No_Component_Reordering): New flag. + (No_Component_Reordering_Config): Likewise. + (Config_Switches_Type): Add No_Component_Reordering component. + * opt.adb (Register_Opt_Config_Switches): Copy + No_Component_Reordering onto No_Component_Reordering_Config. + (Restore_Opt_Config_Switches): Restore No_Component_Reordering. + (Save_Opt_Config_Switches): Save No_Component_Reordering. + (Set_Opt_Config_Switches): Set No_Component_Reordering. + * par-prag.adb (Prag): Deal with Pragma_No_Component_Reordering. + * sem_ch3.adb (Analyze_Private_Extension_Declaration): Also set the + No_Reordering flag from the default. + (Build_Derived_Private_Type): Likewise. + (Build_Derived_Record_Type): Likewise. Then inherit it + for untagged types and clean up handling of similar flags. + (Record_Type_Declaration): Likewise. + * sem_ch13.adb (Same_Representation): Deal with No_Reordering and + remove redundant test on Is_Tagged_Type. + * sem_prag.adb (Analyze_Pragma): Handle No_Component_Reordering. + (Sig_Flags): Likewise. + * snames.ads-tmpl (Name_No_Component_Reordering): New name. + (Pragma_Id): Add Pragma_No_Component_Reordering value. + * warnsw.adb (Set_GNAT_Mode_Warnings): Enable -gnatw.q as well. + * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Record_Type>: + Copy the layout of the parent type only if the No_Reordering + settings match. + (components_to_record): Reorder record types with + convention Ada by default unless No_Reordering is set or -gnatd.r + is specified and do not warn if No_Reordering is set in GNAT mode. + +2017-09-06 Ed Schonberg <schonberg@adacore.com> + + * sem_util.ads, sem_util.adb (Check_Previous_Null_Procedure): + new predicate to reject declarations that can be completions, + when there is a visible prior homograph that is a null procedure. + * sem_ch6.adb (Analyze_Null_Procedure): use it. + * sem_ch8.adb (Analyze_Subprogram_Renaming): ditto. + +2017-09-06 Thomas Quinot <quinot@adacore.com> + + * s-regpat.adb (Compile.Parse_Literal): Fix handling of literal + run of 253 characters or more. + 2017-09-06 Ed Schonberg <schonberg@adacore.com> * einfo.adb (Designated_Type): Use Is_Incomplete_Type to handle diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index d42cb34..2b1d472 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -111,6 +111,7 @@ package body ALI is Locking_Policy_Specified := ' '; No_Normalize_Scalars_Specified := False; No_Object_Specified := False; + No_Component_Reordering_Specified := False; GNATprove_Mode_Specified := False; Normalize_Scalars_Specified := False; Partition_Elaboration_Policy_Specified := ' '; @@ -885,6 +886,7 @@ package body ALI is Main_Priority => -1, Main_CPU => -1, Main_Program => None, + No_Component_Reordering => False, No_Object => False, Normalize_Scalars => False, Ofile_Full_Name => Full_Object_File_Name, @@ -1122,9 +1124,15 @@ package body ALI is elsif C = 'N' then C := Getc; + -- Processing for NC + + if C = 'C' then + ALIs.Table (Id).No_Component_Reordering := True; + No_Component_Reordering_Specified := True; + -- Processing for NO - if C = 'O' then + elsif C = 'O' then ALIs.Table (Id).No_Object := True; No_Object_Specified := True; diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index c51129d..8950298 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -177,6 +177,11 @@ package ALI is -- signalled by GP appearing on the P line. Not set if 'P' appears in -- Ignore_Lines. + No_Component_Reordering : Boolean; + -- Set to True if file was compiled with a configuration pragma file + -- containing pragma No_Component_Reordering. Not set if 'P' appears + -- in Ignore_Lines. + No_Object : Boolean; -- Set to True if no object file generated. Not set if 'P' appears in -- Ignore_Lines. @@ -492,6 +497,10 @@ package ALI is -- Set to False by Initialize_ALI. Set to True if an ali file indicates -- that the file was compiled without normalize scalars. + No_Component_Reordering_Specified : Boolean := False; + -- Set to False by Initialize_ALI. Set to True if an ali file contains + -- the No_Component_Reordering flag. + No_Object_Specified : Boolean := False; -- Set to False by Initialize_ALI. Set to True if an ali file contains -- the No_Object flag. diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb index fa83f89..a1727c6 100644 --- a/gcc/ada/bcheck.adb +++ b/gcc/ada/bcheck.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -49,6 +49,7 @@ package body Bcheck is procedure Check_Consistent_Dynamic_Elaboration_Checking; procedure Check_Consistent_Interrupt_States; procedure Check_Consistent_Locking_Policy; + procedure Check_Consistent_No_Component_Reordering; procedure Check_Consistent_Normalize_Scalars; procedure Check_Consistent_Optimize_Alignment; procedure Check_Consistent_Partition_Elaboration_Policy; @@ -80,6 +81,10 @@ package body Bcheck is Check_Consistent_Locking_Policy; end if; + if No_Component_Reordering_Specified then + Check_Consistent_No_Component_Reordering; + end if; + if Partition_Elaboration_Policy_Specified /= ' ' then Check_Consistent_Partition_Elaboration_Policy; end if; @@ -643,6 +648,69 @@ package body Bcheck is end loop Find_Policy; end Check_Consistent_Locking_Policy; + ---------------------------------------------- + -- Check_Consistent_No_Component_Reordering -- + ---------------------------------------------- + + -- This routine checks for a consistent No_Component_Reordering setting. + -- Note that internal units are excluded from this check, since we don't + -- in any case allow the pragma to affect types in internal units, and + -- there is thus no requirement to recompile the run-time with the setting. + + procedure Check_Consistent_No_Component_Reordering is + OK : Boolean := True; + begin + -- Check that all entries have No_Component_Reordering set + + for A1 in ALIs.First .. ALIs.Last loop + if not Is_Internal_File_Name (ALIs.Table (A1).Sfile) + and then not ALIs.Table (A1).No_Component_Reordering + then + OK := False; + exit; + end if; + end loop; + + -- All do, return + + if OK then + return; + end if; + + -- Here we have an inconsistency + + Consistency_Error_Msg + ("some but not all files compiled with No_Component_Reordering"); + + Write_Eol; + Write_Str ("files compiled with No_Component_Reordering"); + Write_Eol; + + for A1 in ALIs.First .. ALIs.Last loop + if not Is_Internal_File_Name (ALIs.Table (A1).Sfile) + and then ALIs.Table (A1).No_Component_Reordering + then + Write_Str (" "); + Write_Name (ALIs.Table (A1).Sfile); + Write_Eol; + end if; + end loop; + + Write_Eol; + Write_Str ("files compiled without No_Component_Reordering"); + Write_Eol; + + for A1 in ALIs.First .. ALIs.Last loop + if not Is_Internal_File_Name (ALIs.Table (A1).Sfile) + and then not ALIs.Table (A1).No_Component_Reordering + then + Write_Str (" "); + Write_Name (ALIs.Table (A1).Sfile); + Write_Eol; + end if; + end loop; + end Check_Consistent_No_Component_Reordering; + ---------------------------------------- -- Check_Consistent_Normalize_Scalars -- ---------------------------------------- diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 8822265..7e19409 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -108,11 +108,11 @@ package body Debug is -- d.o Conservative elaboration order for indirect calls -- d.p Use original Ada 95 semantics for Bit_Order (disable AI95-0133) -- d.q Suppress optimizations on imported 'in' - -- d.r Enable OK_To_Reorder_Components in non-variant records + -- d.r Disable reordering of components in record types -- d.s Strict secondary stack management -- d.t Disable static allocation of library level dispatch tables -- d.u Enable Modify_Tree_For_C (update tree for c) - -- d.v Enable OK_To_Reorder_Components in variant records + -- d.v -- d.w Do not check for infinite loops -- d.x No exception handlers -- d.y @@ -574,8 +574,7 @@ package body Debug is -- optimizations. This option should not be used; the correct solution -- is to declare the parameter 'in out'. - -- d.r Forces the flag OK_To_Reorder_Components to be set in all record - -- base types that have no discriminants. + -- d.r Do not reorder components in record types. -- d.s The compiler no longer attempts to optimize the calls to secondary -- stack management routines SS_Mark and SS_Release. As a result, each @@ -596,9 +595,6 @@ package body Debug is -- d.u Sets Modify_Tree_For_C mode in which tree is modified to make it -- easier to generate code using a C compiler. - -- d.v Forces the flag OK_To_Reorder_Components to be set in all record - -- base types that have at least one discriminant (v = variant). - -- d.w This flag turns off the scanning of loops to detect possible -- infinite loops. diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index f89e970..1f70a40 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -548,7 +548,7 @@ package body Einfo is -- Warnings_Off_Used Flag236 -- Warnings_Off_Used_Unmodified Flag237 -- Warnings_Off_Used_Unreferenced Flag238 - -- OK_To_Reorder_Components Flag239 + -- No_Reordering Flag239 -- Has_Expanded_Contract Flag240 -- Optimize_Alignment_Space Flag241 @@ -1490,7 +1490,7 @@ package body Einfo is function Has_Complex_Representation (Id : E) return B is begin - pragma Assert (Is_Type (Id)); + pragma Assert (Is_Record_Type (Id)); return Flag140 (Implementation_Base_Type (Id)); end Has_Complex_Representation; @@ -2864,6 +2864,12 @@ package body Einfo is return Flag275 (Id); end No_Predicate_On_Actual; + function No_Reordering (Id : E) return B is + begin + pragma Assert (Is_Record_Type (Id)); + return Flag239 (Implementation_Base_Type (Id)); + end No_Reordering; + function No_Return (Id : E) return B is begin return Flag113 (Id); @@ -2928,12 +2934,6 @@ package body Einfo is return Flag247 (Id); end OK_To_Rename; - function OK_To_Reorder_Components (Id : E) return B is - begin - pragma Assert (Is_Record_Type (Id)); - return Flag239 (Base_Type (Id)); - end OK_To_Reorder_Components; - function Optimize_Alignment_Space (Id : E) return B is begin pragma Assert @@ -4584,7 +4584,7 @@ package body Einfo is procedure Set_Has_Complex_Representation (Id : E; V : B := True) is begin - pragma Assert (Ekind (Id) = E_Record_Type); + pragma Assert (Is_Record_Type (Id) and then Is_Base_Type (Id)); Set_Flag140 (Id, V); end Set_Has_Complex_Representation; @@ -6020,6 +6020,12 @@ package body Einfo is Set_Flag275 (Id, V); end Set_No_Predicate_On_Actual; + procedure Set_No_Reordering (Id : E; V : B := True) is + begin + pragma Assert (Is_Record_Type (Id) and then Is_Base_Type (Id)); + Set_Flag239 (Id, V); + end Set_No_Reordering; + procedure Set_No_Return (Id : E; V : B := True) is begin pragma Assert @@ -6085,13 +6091,6 @@ package body Einfo is Set_Flag247 (Id, V); end Set_OK_To_Rename; - procedure Set_OK_To_Reorder_Components (Id : E; V : B := True) is - begin - pragma Assert - (Is_Record_Type (Id) and then Is_Base_Type (Id)); - Set_Flag239 (Id, V); - end Set_OK_To_Reorder_Components; - procedure Set_Optimize_Alignment_Space (Id : E; V : B := True) is begin pragma Assert @@ -9593,12 +9592,12 @@ package body Einfo is W ("No_Dynamic_Predicate_On_actual", Flag276 (Id)); W ("No_Pool_Assigned", Flag131 (Id)); W ("No_Predicate_On_actual", Flag275 (Id)); + W ("No_Reordering", Flag239 (Id)); W ("No_Return", Flag113 (Id)); W ("No_Strict_Aliasing", Flag136 (Id)); W ("Non_Binary_Modulus", Flag58 (Id)); W ("Nonzero_Is_True", Flag162 (Id)); W ("OK_To_Rename", Flag247 (Id)); - W ("OK_To_Reorder_Components", Flag239 (Id)); W ("Optimize_Alignment_Space", Flag241 (Id)); W ("Optimize_Alignment_Time", Flag242 (Id)); W ("Overlays_Constant", Flag243 (Id)); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 176685e..4985231 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1539,8 +1539,8 @@ package Einfo is -- the package body). -- Has_Complex_Representation (Flag140) [implementation base type only] --- Defined in all type entities. Set only for a record base type to --- which a valid pragma Complex_Representation applies. +-- Defined in record types. Set only for a base type to which a valid +-- pragma Complex_Representation applies. -- Has_Component_Size_Clause (Flag68) [implementation base type only] -- Defined in all type entities. Set if a component size clause is @@ -3630,6 +3630,10 @@ package Einfo is -- in the spec of a generic package, in constructs that forbid discrete -- types with predicates. +-- No_Reordering (Flag239) [implementation base type only] +-- Defined in record types. Set only for a base type to which a valid +-- pragma No_Component_Reordering applies. + -- No_Return (Flag113) -- Defined in all entities. Always false except in the case of procedures -- and generic procedures for which a pragma No_Return is given. @@ -3709,12 +3713,6 @@ package Einfo is -- is only worth setting this flag for composites, since for primitive -- types, it is cheaper to do the copy. --- OK_To_Reorder_Components (Flag239) [base type only] --- Defined in record types. Set if the backend is permitted to reorder --- the components. If not set, the record must be laid out in the order --- in which the components are declared textually. Currently this flag --- can only be set by debug switches. - -- Optimize_Alignment_Space (Flag241) -- Defined in type, subtype, variable, and constant entities. This -- flag records that the type or object is to be layed out in a manner @@ -4527,7 +4525,7 @@ package Einfo is -- Uses_Lock_Free (Flag188) -- Defined in protected type entities. Set to True when the Lock Free --- implementation is used for the protected type. This implemenatation is +-- implementation is used for the protected type. This implementation is -- based on atomic transactions and doesn't require anymore the use of -- Protection object (see System.Tasking.Protected_Objects). @@ -6493,7 +6491,7 @@ package Einfo is -- Is_Controlled (Flag42) (base type only) -- Is_Interface (Flag186) -- Is_Limited_Interface (Flag197) - -- OK_To_Reorder_Components (Flag239) (base type only) + -- No_Reordering (Flag239) (base type only) -- Reverse_Bit_Order (Flag164) (base type only) -- Reverse_Storage_Order (Flag93) (base type only) -- SSO_Set_High_By_Default (Flag273) (base type only) @@ -6522,7 +6520,7 @@ package Einfo is -- Is_Controlled (Flag42) (base type only) -- Is_Interface (Flag186) -- Is_Limited_Interface (Flag197) - -- OK_To_Reorder_Components (Flag239) (base type only) + -- No_Reordering (Flag239) (base type only) -- Reverse_Bit_Order (Flag164) (base type only) -- Reverse_Storage_Order (Flag93) (base type only) -- SSO_Set_High_By_Default (Flag273) (base type only) @@ -7279,6 +7277,7 @@ package Einfo is function No_Dynamic_Predicate_On_Actual (Id : E) return B; function No_Pool_Assigned (Id : E) return B; function No_Predicate_On_Actual (Id : E) return B; + function No_Reordering (Id : E) return B; function No_Return (Id : E) return B; function No_Strict_Aliasing (Id : E) return B; function No_Tagged_Streams_Pragma (Id : E) return N; @@ -7289,7 +7288,6 @@ package Einfo is function Normalized_Position (Id : E) return U; function Normalized_Position_Max (Id : E) return U; function OK_To_Rename (Id : E) return B; - function OK_To_Reorder_Components (Id : E) return B; function Optimize_Alignment_Space (Id : E) return B; function Optimize_Alignment_Time (Id : E) return B; function Original_Access_Type (Id : E) return E; @@ -7971,6 +7969,7 @@ package Einfo is procedure Set_No_Dynamic_Predicate_On_Actual (Id : E; V : B := True); procedure Set_No_Pool_Assigned (Id : E; V : B := True); procedure Set_No_Predicate_On_Actual (Id : E; V : B := True); + procedure Set_No_Reordering (Id : E; V : B := True); procedure Set_No_Return (Id : E; V : B := True); procedure Set_No_Strict_Aliasing (Id : E; V : B := True); procedure Set_No_Tagged_Streams_Pragma (Id : E; V : N); @@ -7981,7 +7980,6 @@ package Einfo is procedure Set_Normalized_Position (Id : E; V : U); procedure Set_Normalized_Position_Max (Id : E; V : U); procedure Set_OK_To_Rename (Id : E; V : B := True); - procedure Set_OK_To_Reorder_Components (Id : E; V : B := True); procedure Set_Optimize_Alignment_Space (Id : E; V : B := True); procedure Set_Optimize_Alignment_Time (Id : E; V : B := True); procedure Set_Original_Access_Type (Id : E; V : E); @@ -8815,6 +8813,7 @@ package Einfo is pragma Inline (No_Dynamic_Predicate_On_Actual); pragma Inline (No_Pool_Assigned); pragma Inline (No_Predicate_On_Actual); + pragma Inline (No_Reordering); pragma Inline (No_Return); pragma Inline (No_Strict_Aliasing); pragma Inline (No_Tagged_Streams_Pragma); @@ -8825,7 +8824,6 @@ package Einfo is pragma Inline (Normalized_Position); pragma Inline (Normalized_Position_Max); pragma Inline (OK_To_Rename); - pragma Inline (OK_To_Reorder_Components); pragma Inline (Optimize_Alignment_Space); pragma Inline (Optimize_Alignment_Time); pragma Inline (Original_Access_Type); @@ -9295,6 +9293,7 @@ package Einfo is pragma Inline (Set_No_Dynamic_Predicate_On_Actual); pragma Inline (Set_No_Pool_Assigned); pragma Inline (Set_No_Predicate_On_Actual); + pragma Inline (Set_No_Reordering); pragma Inline (Set_No_Return); pragma Inline (Set_No_Strict_Aliasing); pragma Inline (Set_No_Tagged_Streams_Pragma); @@ -9305,7 +9304,6 @@ package Einfo is pragma Inline (Set_Normalized_Position); pragma Inline (Set_Normalized_Position_Max); pragma Inline (Set_OK_To_Rename); - pragma Inline (Set_OK_To_Reorder_Components); pragma Inline (Set_Optimize_Alignment_Space); pragma Inline (Set_Optimize_Alignment_Time); pragma Inline (Set_Original_Access_Type); diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index 0ab3772..513cfa9 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -56,7 +56,9 @@ extern char Fold_Lower[], Fold_Upper[]; /* debug: */ -#define Debug_Flag_NN debug__debug_flag_nn +#define Debug_Flag_Dot_R debug__debug_flag_dot_r +#define Debug_Flag_NN debug__debug_flag_nn +extern Boolean Debug_Flag_Dot_R; extern Boolean Debug_Flag_NN; /* einfo: */ diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index e072824..578563a 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -4441,17 +4441,6 @@ package body Freeze is end if; end; - -- Set OK_To_Reorder_Components depending on debug flags - - if Is_Base_Type (Rec) and then Convention (Rec) = Convention_Ada then - if (Has_Discriminants (Rec) and then Debug_Flag_Dot_V) - or else - (not Has_Discriminants (Rec) and then Debug_Flag_Dot_R) - then - Set_OK_To_Reorder_Components (Rec); - end if; - end if; - -- Check for useless pragma Pack when all components placed. We only -- do this check for record types, not subtypes, since a subtype may -- have all its components placed, and it still makes perfectly good diff --git a/gcc/ada/g-socket.ads b/gcc/ada/g-socket.ads index d16310a..aa64c00 100644 --- a/gcc/ada/g-socket.ads +++ b/gcc/ada/g-socket.ads @@ -506,6 +506,7 @@ package GNAT.Sockets is Addr : Inet_Addr_Type (Family); Port : Port_Type; end record; + pragma No_Component_Reordering (Sock_Addr_Type); -- Socket addresses fully define a socket connection with protocol family, -- an Internet address and a port. No_Sock_Addr provides a special value -- for uninitialized socket addresses. diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index a7272e4..c9a701d 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -3331,7 +3331,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) && Stored_Constraint (gnat_entity) != No_Elist && (gnat_parent_type = Underlying_Type (Etype (gnat_entity))) && Is_Record_Type (gnat_parent_type) - && !Is_Unchecked_Union (gnat_parent_type)) + && !Is_Unchecked_Union (gnat_parent_type) + && No_Reordering (gnat_entity) == No_Reordering (gnat_parent_type)) { tree gnu_parent_type = TYPE_MAIN_VARIANT (gnat_to_gnu_type (gnat_parent_type)); @@ -7692,9 +7693,7 @@ components_to_record (Node_Id gnat_component_list, Entity_Id gnat_record_type, } /* Scan GNU_FIELD_LIST and see if any fields have rep clauses. If they do, - pull them out and put them onto the appropriate list. We have to do it - in a separate pass since we want to handle the discriminants but can't - play with them until we've used them in debugging data above. + pull them out and put them onto the appropriate list. Similarly, pull out the fields with zero size and no rep clause, as they would otherwise modify the layout and thus very likely run afoul of the @@ -7714,16 +7713,16 @@ components_to_record (Node_Id gnat_component_list, Entity_Id gnat_record_type, different kinds of fields and issue a warning if some of them would be (or are being) reordered by the reordering mechanism. - Finally, pull out the fields whose size is not a multiple of a byte, so - that they don't cause the regular fields to be misaligned. As this can - only happen in packed record types, the alignment is capped to the byte. - - ??? If we reorder them, debugging information will be wrong but there is - nothing that can be done about this at the moment. */ - const bool do_reorder = OK_To_Reorder_Components (gnat_record_type); + ??? If we reorder fields, the debugging information will be affected and + the debugger print fields in a different order from the source code. */ + const bool do_reorder + = (Convention (gnat_record_type) == Convention_Ada + && !No_Reordering (gnat_record_type) + && !debug__debug_flag_dot_r); const bool w_reorder - = Warn_On_Questionable_Layout - && (Convention (gnat_record_type) == Convention_Ada); + = (Convention (gnat_record_type) == Convention_Ada + && Warn_On_Questionable_Layout + && !(No_Reordering (gnat_record_type) && GNAT_Mode)); const bool in_variant = (p_gnu_rep_list != NULL); tree gnu_zero_list = NULL_TREE; tree gnu_self_list = NULL_TREE; diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index 895e185..8c36957 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -1194,6 +1194,10 @@ package body Lib.Writ is Write_Info_Char (Partition_Elaboration_Policy); end if; + if No_Component_Reordering_Config then + Write_Info_Str (" NC"); + end if; + if not Object then Write_Info_Str (" NO"); end if; diff --git a/gcc/ada/opt.adb b/gcc/ada/opt.adb index 91642ed..ef1a1d4 100644 --- a/gcc/ada/opt.adb +++ b/gcc/ada/opt.adb @@ -102,6 +102,7 @@ package body Opt is External_Name_Imp_Casing_Config := External_Name_Imp_Casing; Fast_Math_Config := Fast_Math; Initialize_Scalars_Config := Initialize_Scalars; + No_Component_Reordering_Config := No_Component_Reordering; Optimize_Alignment_Config := Optimize_Alignment; Persistent_BSS_Mode_Config := Persistent_BSS_Mode; Polling_Required_Config := Polling_Required; @@ -141,6 +142,7 @@ package body Opt is External_Name_Imp_Casing := Save.External_Name_Imp_Casing; Fast_Math := Save.Fast_Math; Initialize_Scalars := Save.Initialize_Scalars; + No_Component_Reordering := Save.No_Component_Reordering; Optimize_Alignment := Save.Optimize_Alignment; Optimize_Alignment_Local := Save.Optimize_Alignment_Local; Persistent_BSS_Mode := Save.Persistent_BSS_Mode; @@ -182,6 +184,7 @@ package body Opt is Save.External_Name_Imp_Casing := External_Name_Imp_Casing; Save.Fast_Math := Fast_Math; Save.Initialize_Scalars := Initialize_Scalars; + Save.No_Component_Reordering := No_Component_Reordering; Save.Optimize_Alignment := Optimize_Alignment; Save.Optimize_Alignment_Local := Optimize_Alignment_Local; Save.Persistent_BSS_Mode := Persistent_BSS_Mode; @@ -218,6 +221,7 @@ package body Opt is Extensions_Allowed := True; External_Name_Exp_Casing := As_Is; External_Name_Imp_Casing := Lowercase; + No_Component_Reordering := False; Optimize_Alignment := 'O'; Optimize_Alignment_Local := True; Persistent_BSS_Mode := False; @@ -269,6 +273,7 @@ package body Opt is External_Name_Imp_Casing := External_Name_Imp_Casing_Config; Fast_Math := Fast_Math_Config; Initialize_Scalars := Initialize_Scalars_Config; + No_Component_Reordering := No_Component_Reordering_Config; Optimize_Alignment := Optimize_Alignment_Config; Optimize_Alignment_Local := False; Persistent_BSS_Mode := Persistent_BSS_Mode_Config; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 2dbfef0..8f6820a 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -1107,6 +1107,10 @@ package Opt is -- GNATNAME -- Do not create backup copies of project files. Set by switch --no-backup. + No_Component_Reordering : Boolean := False; + -- GNAT + -- Set True if pragma No_Component_Reordering with no parameter encountered + No_Deletion : Boolean := False; -- GNATPREP -- Set by preprocessor switch -a. Do not eliminate any source text. Implies @@ -2025,6 +2029,14 @@ package Opt is -- This switch is not set when the pragma appears ahead of a given -- unit, so it does not affect the compilation of other units. + No_Component_Reordering_Config : Boolean; + -- GNAT + -- This is the value of the configuration switch that is set by the + -- pragma No_Component_Reordering when it appears in the gnat.adc file. + -- This flag is used to set the initial value of No_Component_Reordering + -- at the start of each compilation unit, except that it is always set + -- False for predefined units. + No_Exit_Message : Boolean := False; -- GNATMAKE, GPRBUILD -- Set with switch --no-exit-message. When True, if there are compilation @@ -2089,8 +2101,7 @@ package Opt is procedure Save_Opt_Config_Switches (Save : out Config_Switches_Type); -- This procedure saves the current values of the switches which are - -- initialized from the above Config values, and then resets these switches - -- according to the Config value settings. + -- initialized from the above Config values. procedure Set_Opt_Config_Switches (Internal_Unit : Boolean; @@ -2306,6 +2317,7 @@ private External_Name_Imp_Casing : External_Casing_Type; Fast_Math : Boolean; Initialize_Scalars : Boolean; + No_Component_Reordering : Boolean; Normalize_Scalars : Boolean; Optimize_Alignment : Character; Optimize_Alignment_Local : Boolean; diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb index cea5899..d0f5539 100644 --- a/gcc/ada/par-prag.adb +++ b/gcc/ada/par-prag.adb @@ -1414,6 +1414,7 @@ begin | Pragma_Max_Queue_Length | Pragma_Memory_Size | Pragma_No_Body + | Pragma_No_Component_Reordering | Pragma_No_Elaboration_Code_All | Pragma_No_Heap_Finalization | Pragma_No_Inline diff --git a/gcc/ada/prj-attr.ads b/gcc/ada/prj-attr.ads index e821a82..ad2f033 100644 --- a/gcc/ada/prj-attr.ads +++ b/gcc/ada/prj-attr.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -87,6 +87,7 @@ package Prj.Attr is type Attribute_Data (Name_Length : Attribute_Name_Length := 1) is record Name : String (1 .. Name_Length); + pragma Warnings (Off, Name); -- Reorder it instead??? -- The name of the attribute Attr_Kind : Defined_Attribute_Kind; diff --git a/gcc/ada/s-regpat.adb b/gcc/ada/s-regpat.adb index f27639b..9ea4e36 100644 --- a/gcc/ada/s-regpat.adb +++ b/gcc/ada/s-regpat.adb @@ -7,7 +7,7 @@ -- B o d y -- -- -- -- Copyright (C) 1986 by University of Toronto. -- --- Copyright (C) 1999-2016, AdaCore -- +-- Copyright (C) 1999-2017, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1634,11 +1634,9 @@ package body System.Regpat is Case_Emit (C); end case; - exit Parse_Loop when Emit_Ptr - Length_Ptr = 254; - Parse_Pos := Parse_Pos + 1; - - exit Parse_Loop when Parse_Pos > Parse_End; + exit Parse_Loop when Parse_Pos > Parse_End + or else Emit_Ptr - Length_Ptr = 254; end loop Parse_Loop; -- Is the string followed by a '*+?{' operator ? If yes, and if there diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index e78894c..b3d9def 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -12799,7 +12799,8 @@ package body Sem_Ch13 is return True; end if; - -- Tagged types never have differing representations + -- Tagged types always have the same representation, because it is not + -- possible to specify different representations for common fields. if Is_Tagged_Type (T1) then return True; @@ -12837,6 +12838,15 @@ package body Sem_Ch13 is end if; end if; + -- For records, representations are different if reorderings differ + + if Is_Record_Type (T1) + and then Is_Record_Type (T2) + and then No_Reordering (T1) /= No_Reordering (T2) + then + return False; + end if; + -- Types definitely have same representation if neither has non-standard -- representation since default representations are always consistent. -- If only one has non-standard representation, and the other does not, @@ -12861,12 +12871,6 @@ package body Sem_Ch13 is if Is_Array_Type (T1) then return Component_Size (T1) = Component_Size (T2); - -- Tagged types always have the same representation, because it is not - -- possible to specify different representations for common fields. - - elsif Is_Tagged_Type (T1) then - return True; - -- Case of record types elsif Is_Record_Type (T1) then diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 6fbcea27..93a2c89 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -5015,6 +5015,7 @@ package body Sem_Ch3 is Set_Ekind (T, E_Record_Type_With_Private); Init_Size_Align (T); Set_Default_SSO (T); + Set_No_Reordering (T, No_Component_Reordering); Set_Etype (T, Parent_Base); Propagate_Concurrent_Flags (T, Parent_Base); @@ -7679,6 +7680,7 @@ package body Sem_Ch3 is Set_Ekind (Full_Der, E_Record_Type); Set_Is_Underlying_Record_View (Full_Der); Set_Default_SSO (Full_Der); + Set_No_Reordering (Full_Der, No_Component_Reordering); Analyze (Decl); @@ -8478,6 +8480,7 @@ package body Sem_Ch3 is Type_Def := N; Set_Ekind (Derived_Type, E_Record_Type_With_Private); Set_Default_SSO (Derived_Type); + Set_No_Reordering (Derived_Type, No_Component_Reordering); else Type_Def := Type_Definition (N); @@ -8492,6 +8495,7 @@ package body Sem_Ch3 is if Present (Record_Extension_Part (Type_Def)) then Set_Ekind (Derived_Type, E_Record_Type); Set_Default_SSO (Derived_Type); + Set_No_Reordering (Derived_Type, No_Component_Reordering); -- Create internal access types for components with anonymous -- access types. @@ -9112,60 +9116,45 @@ package body Sem_Ch3 is Set_Has_Primitive_Operations (Derived_Type, Has_Primitive_Operations (Parent_Base)); - -- Fields inherited from the Parent_Base in the non-private case + -- Set fields for private derived types - if Ekind (Derived_Type) = E_Record_Type then - Set_Has_Complex_Representation - (Derived_Type, Has_Complex_Representation (Parent_Base)); + if Is_Private_Type (Derived_Type) then + Set_Depends_On_Private (Derived_Type, True); + Set_Private_Dependents (Derived_Type, New_Elmt_List); end if; - -- Fields inherited from the Parent_Base for record types + -- Inherit fields for non-private types. If this is the completion of a + -- derivation from a private type, the parent itself is private and the + -- attributes come from its full view, which must be present. if Is_Record_Type (Derived_Type) then declare Parent_Full : Entity_Id; begin - -- Ekind (Parent_Base) is not necessarily E_Record_Type since - -- Parent_Base can be a private type or private extension. Go - -- to the full view here to get the E_Record_Type specific flags. - - if Present (Full_View (Parent_Base)) then + if Is_Private_Type (Parent_Base) + and then not Is_Record_Type (Parent_Base) + then Parent_Full := Full_View (Parent_Base); else Parent_Full := Parent_Base; end if; - Set_OK_To_Reorder_Components - (Derived_Type, OK_To_Reorder_Components (Parent_Full)); - end; - end if; - - -- Set fields for private derived types - - if Is_Private_Type (Derived_Type) then - Set_Depends_On_Private (Derived_Type, True); - Set_Private_Dependents (Derived_Type, New_Elmt_List); - - -- Inherit fields from non private record types. If this is the - -- completion of a derivation from a private type, the parent itself - -- is private, and the attributes come from its full view, which must - -- be present. - - else - if Is_Private_Type (Parent_Base) - and then not Is_Record_Type (Parent_Base) - then Set_Component_Alignment - (Derived_Type, Component_Alignment (Full_View (Parent_Base))); + (Derived_Type, Component_Alignment (Parent_Full)); Set_C_Pass_By_Copy - (Derived_Type, C_Pass_By_Copy (Full_View (Parent_Base))); - else - Set_Component_Alignment - (Derived_Type, Component_Alignment (Parent_Base)); - Set_C_Pass_By_Copy - (Derived_Type, C_Pass_By_Copy (Parent_Base)); - end if; + (Derived_Type, C_Pass_By_Copy (Parent_Full)); + Set_Has_Complex_Representation + (Derived_Type, Has_Complex_Representation (Parent_Full)); + + -- For untagged types, inherit the layout by default to avoid + -- costly changes of representation for type conversions. + + if not Is_Tagged then + Set_Is_Packed (Derived_Type, Is_Packed (Parent_Full)); + Set_No_Reordering (Derived_Type, No_Reordering (Parent_Full)); + end if; + end; end if; -- Set fields for tagged types @@ -9270,11 +9259,6 @@ package body Sem_Ch3 is end if; end; end if; - - else - Set_Is_Packed (Derived_Type, Is_Packed (Parent_Base)); - Set_Has_Non_Standard_Rep - (Derived_Type, Has_Non_Standard_Rep (Parent_Base)); end if; -- STEP 4: Inherit components from the parent base and constrain them. @@ -21540,6 +21524,7 @@ package body Sem_Ch3 is Set_Interfaces (T, No_Elist); Set_Stored_Constraint (T, No_Elist); Set_Default_SSO (T); + Set_No_Reordering (T, No_Component_Reordering); -- Normal case diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 61e4f86..fc01d8b 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1468,11 +1468,14 @@ package body Sem_Ch6 is -- there are various error checks that are applied on this body -- when it is analyzed (e.g. correct aspect placement). - if Has_Completion (Prev) then + if Has_Completion (Prev) + then Error_Msg_Sloc := Sloc (Prev); Error_Msg_NE ("duplicate body for & declared#", N, Prev); end if; + Check_Previous_Null_Procedure (N, Prev); + Is_Completion := True; Rewrite (N, Null_Body); Analyze (N); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index f765bb8..ac1897c 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -2893,6 +2893,8 @@ package body Sem_Ch8 is if Present (Rename_Spec) then + Check_Previous_Null_Procedure (N, Rename_Spec); + -- Renaming declaration is the completion of the declaration of -- Rename_Spec. We build an actual body for it at the freezing point. diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 6aad5d4..2e280a5 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -14398,10 +14398,10 @@ package body Sem_Prag is if Etype (E_Id) = Any_Type then return; - else - E := Entity (E_Id); end if; + E := Entity (E_Id); + -- A pragma that applies to a Ghost entity becomes Ghost for -- the purposes of legality checks and removal of ignored -- Ghost code. @@ -18066,6 +18066,43 @@ package body Sem_Prag is Opt.No_Elab_Code_All_Pragma := N; end if; + ----------------------------- + -- No_Component_Reordering -- + ----------------------------- + + -- pragma No_Component_Reordering [([Entity =>] type_LOCAL_NAME)]; + + when Pragma_No_Component_Reordering => No_Comp_Reordering : declare + E : Entity_Id; + E_Id : Node_Id; + + begin + GNAT_Pragma; + Check_At_Most_N_Arguments (1); + + if Arg_Count = 0 then + Check_Valid_Configuration_Pragma; + Opt.No_Component_Reordering := True; + + else + Check_Optional_Identifier (Arg2, Name_Entity); + Check_Arg_Is_Local_Name (Arg1); + E_Id := Get_Pragma_Arg (Arg1); + + if Etype (E_Id) = Any_Type then + return; + end if; + + E := Entity (E_Id); + + if not Is_Record_Type (E) then + Error_Pragma_Arg ("pragma% requires record type", Arg1); + end if; + + Set_No_Reordering (Base_Type (E)); + end if; + end No_Comp_Reordering; + -------------------------- -- No_Heap_Finalization -- -------------------------- @@ -18443,7 +18480,8 @@ package body Sem_Prag is -- pragma No_Strict_Aliasing [([Entity =>] type_LOCAL_NAME)]; when Pragma_No_Strict_Aliasing => No_Strict_Aliasing : declare - E_Id : Entity_Id; + E : Entity_Id; + E_Id : Node_Id; begin GNAT_Pragma; @@ -18456,15 +18494,19 @@ package body Sem_Prag is else Check_Optional_Identifier (Arg2, Name_Entity); Check_Arg_Is_Local_Name (Arg1); - E_Id := Entity (Get_Pragma_Arg (Arg1)); + E_Id := Get_Pragma_Arg (Arg1); - if E_Id = Any_Type then + if Etype (E_Id) = Any_Type then return; - elsif No (E_Id) or else not Is_Access_Type (E_Id) then + end if; + + E := Entity (E_Id); + + if not Is_Access_Type (E) then Error_Pragma_Arg ("pragma% requires access type", Arg1); end if; - Set_No_Strict_Aliasing (Implementation_Base_Type (E_Id)); + Set_No_Strict_Aliasing (Base_Type (E)); end if; end No_Strict_Aliasing; @@ -20369,7 +20411,7 @@ package body Sem_Prag is Check_Arg_Is_Local_Name (Arg1); E_Id := Get_Pragma_Arg (Arg1); - if Error_Posted (E_Id) then + if Etype (E_Id) = Any_Type then return; end if; @@ -23164,27 +23206,32 @@ package body Sem_Prag is -- pragma Universal_Aliasing [([Entity =>] type_LOCAL_NAME)]; when Pragma_Universal_Aliasing => Universal_Alias : declare - E_Id : Entity_Id; + E : Entity_Id; + E_Id : Node_Id; begin GNAT_Pragma; Check_Arg_Count (1); Check_Optional_Identifier (Arg2, Name_Entity); Check_Arg_Is_Local_Name (Arg1); - E_Id := Entity (Get_Pragma_Arg (Arg1)); + E_Id := Get_Pragma_Arg (Arg1); - if E_Id = Any_Type then + if Etype (E_Id) = Any_Type then return; - elsif No (E_Id) or else not Is_Type (E_Id) then + end if; + + E := Entity (E_Id); + + if not Is_Type (E) then Error_Pragma_Arg ("pragma% requires type", Arg1); end if; -- A pragma that applies to a Ghost entity becomes Ghost for the -- purposes of legality checks and removal of ignored Ghost code. - Mark_Ghost_Pragma (N, E_Id); - Set_Universal_Aliasing (Implementation_Base_Type (E_Id)); - Record_Rep_Item (E_Id, N); + Mark_Ghost_Pragma (N, E); + Set_Universal_Aliasing (Base_Type (E)); + Record_Rep_Item (E, N); end Universal_Alias; -------------------- @@ -29293,6 +29340,7 @@ package body Sem_Prag is Pragma_Memory_Size => 0, Pragma_No_Return => 0, Pragma_No_Body => 0, + Pragma_No_Component_Reordering => -1, Pragma_No_Elaboration_Code_All => 0, Pragma_No_Heap_Finalization => 0, Pragma_No_Inline => 0, diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index d9babcd..6126b20 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1900,6 +1900,25 @@ package body Sem_Util is end if; end Cannot_Raise_Constraint_Error; + ------------------------------------ + -- Check_Previous_Null_Procedure -- + ------------------------------------ + + procedure Check_Previous_Null_Procedure + (Decl : Node_Id; + Prev : Entity_Id) + is + begin + if Ekind (Prev) = E_Procedure + and then Nkind (Parent (Prev)) = N_Procedure_Specification + and then Null_Present (Parent (Prev)) + then + Error_Msg_Sloc := Sloc (Prev); + Error_Msg_N + ("declaration cannot complete previous null procedure#", Decl); + end if; + end Check_Previous_Null_Procedure; + ----------------------------- -- Check_Part_Of_Reference -- ----------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 74e1841..8f0520a 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -365,6 +365,16 @@ package Sem_Util is -- N is one of the statement forms that is a potentially blocking -- operation. If it appears within a protected action, emit warning. + procedure Check_Previous_Null_Procedure + (Decl : Node_Id; + Prev : Entity_Id); + -- A null procedure or a subprogram renaming can complete a previous + -- declaration, unless that previous declaration is itself a null + -- procedure. This must be treated specially because the analysis of + -- the null procedure leaves the corresponding entity as having no + -- completion, because its completion is provided by a generated body + -- inserted after all other declarations. + procedure Check_Result_And_Post_State (Subp_Id : Entity_Id); -- Determine whether the contract of subprogram Subp_Id mentions attribute -- 'Result and it contains an expression that evaluates differently in pre- diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index cdf2ca6..600c847 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -432,6 +432,7 @@ package Snames is Name_Interrupt_State : constant Name_Id := N + $; -- GNAT Name_License : constant Name_Id := N + $; -- GNAT Name_Locking_Policy : constant Name_Id := N + $; + Name_No_Component_Reordering : constant Name_Id := N + $; -- GNAT Name_No_Heap_Finalization : constant Name_Id := N + $; -- GNAT Name_No_Run_Time : constant Name_Id := N + $; -- GNAT Name_No_Strict_Aliasing : constant Name_Id := N + $; -- GNAT @@ -1810,6 +1811,7 @@ package Snames is Pragma_Interrupt_State, Pragma_License, Pragma_Locking_Policy, + Pragma_No_Component_Reordering, Pragma_No_Heap_Finalization, Pragma_No_Run_Time, Pragma_No_Strict_Aliasing, diff --git a/gcc/ada/warnsw.adb b/gcc/ada/warnsw.adb index 2fd1330..461f300 100644 --- a/gcc/ada/warnsw.adb +++ b/gcc/ada/warnsw.adb @@ -485,6 +485,7 @@ package body Warnsw is -- These warnings are added to the -gnatwa set Address_Clause_Overlay_Warnings := True; + Warn_On_Questionable_Layout := True; Warn_On_Overridden_Size := True; -- These warnings are removed from the -gnatwa set |