summaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog72
-rw-r--r--gcc/ada/ali.adb12
-rw-r--r--gcc/ada/ali.ads11
-rw-r--r--gcc/ada/bcheck.adb70
-rw-r--r--gcc/ada/debug.adb10
-rw-r--r--gcc/ada/einfo.adb33
-rw-r--r--gcc/ada/einfo.ads28
-rw-r--r--gcc/ada/fe.h4
-rw-r--r--gcc/ada/freeze.adb11
-rw-r--r--gcc/ada/g-socket.ads1
-rw-r--r--gcc/ada/gcc-interface/decl.c25
-rw-r--r--gcc/ada/lib-writ.adb4
-rw-r--r--gcc/ada/opt.adb5
-rw-r--r--gcc/ada/opt.ads16
-rw-r--r--gcc/ada/par-prag.adb1
-rw-r--r--gcc/ada/prj-attr.ads3
-rw-r--r--gcc/ada/s-regpat.adb8
-rw-r--r--gcc/ada/sem_ch13.adb18
-rw-r--r--gcc/ada/sem_ch3.adb71
-rw-r--r--gcc/ada/sem_ch6.adb5
-rw-r--r--gcc/ada/sem_ch8.adb2
-rw-r--r--gcc/ada/sem_prag.adb78
-rw-r--r--gcc/ada/sem_util.adb19
-rw-r--r--gcc/ada/sem_util.ads10
-rw-r--r--gcc/ada/snames.ads-tmpl2
-rw-r--r--gcc/ada/warnsw.adb1
26 files changed, 378 insertions, 142 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index af389109ff7..97453305e61 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 d42cb34431a..2b1d472baba 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 c51129df0db..8950298b7a9 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 fa83f89983a..a1727c6652a 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 8822265c928..7e1940940d4 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 f89e9704caf..1f70a405d1f 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 176685ea286..49852311af0 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 0ab37720a8d..513cfa97daa 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 e072824a486..578563a800d 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 d16310a76d2..aa64c008368 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 a7272e4ae8e..c9a701dabee 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 895e185d87c..8c36957228c 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 91642ed948d..ef1a1d41448 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 2dbfef05918..8f6820a0dbf 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 cea58991e65..d0f5539c873 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 e821a8249dc..ad2f033e7ad 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 f27639b978a..9ea4e360255 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 e78894c867d..b3d9defbc12 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 6fbcea27ce2..93a2c891d5d 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 61e4f86c6ca..fc01d8b015f 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 f765bb8dda3..ac1897cdab5 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 6aad5d49a54..2e280a5c760 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 d9babcd8b3b..6126b201e50 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 74e1841a0dd..8f0520a3298 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 cdf2ca66e95..600c847aa95 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 2fd133000e6..461f300f33d 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