aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/bcheck.adb
blob: fc2b9b620357fc6fac2ee0bc049f8b948c8ba33c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                               B C H E C K                                --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1992-2013, 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- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with ALI;      use ALI;
with ALI.Util; use ALI.Util;
with Binderr;  use Binderr;
with Butil;    use Butil;
with Casing;   use Casing;
with Fname;    use Fname;
with Namet;    use Namet;
with Opt;      use Opt;
with Osint;
with Output;   use Output;
with Rident;   use Rident;
with Types;    use Types;

package body Bcheck is

   -----------------------
   -- Local Subprograms --
   -----------------------

   --  The following checking subprograms make up the parts of the
   --  configuration consistency check. See bodies for details of checks.

   procedure Check_Consistent_Dispatching_Policy;
   procedure Check_Consistent_Dynamic_Elaboration_Checking;
   procedure Check_Consistent_Floating_Point_Format;
   procedure Check_Consistent_Interrupt_States;
   procedure Check_Consistent_Locking_Policy;
   procedure Check_Consistent_Normalize_Scalars;
   procedure Check_Consistent_Optimize_Alignment;
   procedure Check_Consistent_Partition_Elaboration_Policy;
   procedure Check_Consistent_Queuing_Policy;
   procedure Check_Consistent_Restrictions;
   procedure Check_Consistent_Restriction_No_Default_Initialization;
   procedure Check_Consistent_Zero_Cost_Exception_Handling;

   procedure Consistency_Error_Msg (Msg : String);
   --  Produce an error or a warning message, depending on whether an
   --  inconsistent configuration is permitted or not.

   function Same_Unit (U1 : Unit_Name_Type; U2 : Name_Id) return Boolean;
   --  Used to compare two unit names for No_Dependence checks. U1 is in
   --  standard unit name format, and U2 is in literal form with periods.

   -------------------------------------
   -- Check_Configuration_Consistency --
   -------------------------------------

   procedure Check_Configuration_Consistency is
   begin
      if Float_Format_Specified /= ' ' then
         Check_Consistent_Floating_Point_Format;
      end if;

      if Queuing_Policy_Specified /= ' ' then
         Check_Consistent_Queuing_Policy;
      end if;

      if Locking_Policy_Specified /= ' ' then
         Check_Consistent_Locking_Policy;
      end if;

      if Partition_Elaboration_Policy_Specified /= ' ' then
         Check_Consistent_Partition_Elaboration_Policy;
      end if;

      if Zero_Cost_Exceptions_Specified then
         Check_Consistent_Zero_Cost_Exception_Handling;
      end if;

      Check_Consistent_Normalize_Scalars;
      Check_Consistent_Optimize_Alignment;
      Check_Consistent_Dynamic_Elaboration_Checking;
      Check_Consistent_Restrictions;
      Check_Consistent_Restriction_No_Default_Initialization;
      Check_Consistent_Interrupt_States;
      Check_Consistent_Dispatching_Policy;
   end Check_Configuration_Consistency;

   -----------------------
   -- Check_Consistency --
   -----------------------

   procedure Check_Consistency is
      Src : Source_Id;
      --  Source file Id for this Sdep entry

      ALI_Path_Id : File_Name_Type;

   begin
      --  First, we go through the source table to see if there are any cases
      --  in which we should go after source files and compute checksums of
      --  the source files. We need to do this for any file for which we have
      --  mismatching time stamps and (so far) matching checksums.

      for S in Source.First .. Source.Last loop

         --  If all time stamps for a file match, then there is nothing to
         --  do, since we will not be checking checksums in that case anyway

         if Source.Table (S).All_Timestamps_Match then
            null;

         --  If we did not find the source file, then we can't compute its
         --  checksum anyway. Note that when we have a time stamp mismatch,
         --  we try to find the source file unconditionally (i.e. if
         --  Check_Source_Files is False).

         elsif not Source.Table (S).Source_Found then
            null;

         --  If we already have non-matching or missing checksums, then no
         --  need to try going after source file, since we won't trust the
         --  checksums in any case.

         elsif not Source.Table (S).All_Checksums_Match then
            null;

         --  Now we have the case where we have time stamp mismatches, and
         --  the source file is around, but so far all checksums match. This
         --  is the case where we need to compute the checksum from the source
         --  file, since otherwise we would ignore the time stamp mismatches,
         --  and that is wrong if the checksum of the source does not agree
         --  with the checksums in the ALI files.

         elsif Check_Source_Files then
            if not Checksums_Match
              (Source.Table (S).Checksum,
               Get_File_Checksum (Source.Table (S).Sfile))
            then
               Source.Table (S).All_Checksums_Match := False;
            end if;
         end if;
      end loop;

      --  Loop through ALI files

      ALIs_Loop : for A in ALIs.First .. ALIs.Last loop

         --  Loop through Sdep entries in one ALI file

         Sdep_Loop : for D in
           ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
         loop
            if Sdep.Table (D).Dummy_Entry then
               goto Continue;
            end if;

            Src := Source_Id (Get_Name_Table_Info (Sdep.Table (D).Sfile));

            --  If the time stamps match, or all checksums match, then we
            --  are OK, otherwise we have a definite error.

            if Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
              and then not Source.Table (Src).All_Checksums_Match
            then
               Error_Msg_File_1 := ALIs.Table (A).Sfile;
               Error_Msg_File_2 := Sdep.Table (D).Sfile;

               --  Two styles of message, depending on whether or not
               --  the updated file is the one that must be recompiled

               if Error_Msg_File_1 = Error_Msg_File_2 then
                  if Tolerate_Consistency_Errors then
                     Error_Msg
                        ("?{ has been modified and should be recompiled");
                  else
                     Error_Msg
                       ("{ has been modified and must be recompiled");
                  end if;

               else
                  ALI_Path_Id :=
                    Osint.Full_Lib_File_Name (ALIs.Table (A).Afile);

                  if Osint.Is_Readonly_Library (ALI_Path_Id) then
                     if Tolerate_Consistency_Errors then
                        Error_Msg ("?{ should be recompiled");
                        Error_Msg_File_1 := ALI_Path_Id;
                        Error_Msg ("?({ is obsolete and read-only)");
                     else
                        Error_Msg ("{ must be compiled");
                        Error_Msg_File_1 := ALI_Path_Id;
                        Error_Msg ("({ is obsolete and read-only)");
                     end if;

                  elsif Tolerate_Consistency_Errors then
                     Error_Msg
                       ("?{ should be recompiled ({ has been modified)");

                  else
                     Error_Msg ("{ must be recompiled ({ has been modified)");
                  end if;
               end if;

               if (not Tolerate_Consistency_Errors) and Verbose_Mode then
                  Error_Msg_File_1 := Source.Table (Src).Stamp_File;

                  if Source.Table (Src).Source_Found then
                     Error_Msg_File_1 :=
                       Osint.Full_Source_Name (Error_Msg_File_1);
                  else
                     Error_Msg_File_1 :=
                       Osint.Full_Lib_File_Name (Error_Msg_File_1);
                  end if;

                  Error_Msg
                    ("time stamp from { " & String (Source.Table (Src).Stamp));

                  Error_Msg_File_1 := Sdep.Table (D).Sfile;
                  Error_Msg
                    (" conflicts with { timestamp " &
                     String (Sdep.Table (D).Stamp));

                  Error_Msg_File_1 :=
                    Osint.Full_Lib_File_Name (ALIs.Table (A).Afile);
                  Error_Msg (" from {");
               end if;

               --  Exit from the loop through Sdep entries once we find one
               --  that does not match.

               exit Sdep_Loop;
            end if;

         <<Continue>>
            null;
         end loop Sdep_Loop;
      end loop ALIs_Loop;
   end Check_Consistency;

   -----------------------------------------
   -- Check_Consistent_Dispatching_Policy --
   -----------------------------------------

   --  The rule is that all files for which the dispatching policy is
   --  significant must meet the following rules:

   --    1. All files for which a task dispatching policy is significant must
   --    be compiled with the same setting.

   --    2. If a partition contains one or more Priority_Specific_Dispatching
   --    pragmas it cannot contain a Task_Dispatching_Policy pragma.

   --    3. No overlap is allowed in the priority ranges specified in
   --    Priority_Specific_Dispatching pragmas within the same partition.

   --    4. If a partition contains one or more Priority_Specific_Dispatching
   --    pragmas then the Ceiling_Locking policy is the only one allowed for
   --    the partition.

   procedure Check_Consistent_Dispatching_Policy is
      Max_Prio : Nat := 0;
      --  Maximum priority value for which a Priority_Specific_Dispatching
      --  pragma has been specified.

      TDP_Pragma_Afile : ALI_Id := No_ALI_Id;
      --  ALI file where a Task_Dispatching_Policy pragma appears

   begin
      --  Consistency checks in units specifying a Task_Dispatching_Policy

      if Task_Dispatching_Policy_Specified /= ' ' then
         Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
            if ALIs.Table (A1).Task_Dispatching_Policy /= ' ' then

               --  Store the place where the first task dispatching pragma
               --  appears. We may need this value for issuing consistency
               --  errors if Priority_Specific_Dispatching pragmas are used.

               TDP_Pragma_Afile := A1;

               Check_Policy : declare
                  Policy : constant Character :=
                    ALIs.Table (A1).Task_Dispatching_Policy;

               begin
                  for A2 in A1 + 1 .. ALIs.Last loop
                     if ALIs.Table (A2).Task_Dispatching_Policy /= ' '
                          and then
                        ALIs.Table (A2).Task_Dispatching_Policy /= Policy
                     then
                        Error_Msg_File_1 := ALIs.Table (A1).Sfile;
                        Error_Msg_File_2 := ALIs.Table (A2).Sfile;

                        Consistency_Error_Msg
                          ("{ and { compiled with different task" &
                           " dispatching policies");
                        exit Find_Policy;
                     end if;
                  end loop;
               end Check_Policy;

               exit Find_Policy;
            end if;
         end loop Find_Policy;
      end if;

      --  If no Priority_Specific_Dispatching entries, nothing else to do

      if Specific_Dispatching.Last >= Specific_Dispatching.First then

         --  Find out the maximum priority value for which one of the
         --  Priority_Specific_Dispatching pragmas applies.

         Max_Prio := 0;
         for J in Specific_Dispatching.First .. Specific_Dispatching.Last loop
            if Specific_Dispatching.Table (J).Last_Priority > Max_Prio then
               Max_Prio := Specific_Dispatching.Table (J).Last_Priority;
            end if;
         end loop;

         --  Now establish tables to be used for consistency checking

         declare
            --  The following record type is used to record locations of the
            --  Priority_Specific_Dispatching pragmas applying to the Priority.

            type Specific_Dispatching_Entry is record
               Dispatching_Policy : Character := ' ';
               --  First character (upper case) of corresponding policy name

               Afile : ALI_Id := No_ALI_Id;
               --  ALI file that generated Priority Specific Dispatching
               --  entry for consistency message.

               Loc : Nat := 0;
               --  Line numbers from Priority_Specific_Dispatching pragma
            end record;

            PSD_Table  : array (0 .. Max_Prio) of Specific_Dispatching_Entry :=
              (others => Specific_Dispatching_Entry'
                 (Dispatching_Policy => ' ',
                  Afile              => No_ALI_Id,
                  Loc                => 0));
            --  Array containing an entry per priority containing the location
            --  where there is a Priority_Specific_Dispatching pragma that
            --  applies to the priority.

         begin
            for F in ALIs.First .. ALIs.Last loop
               for K in ALIs.Table (F).First_Specific_Dispatching ..
                        ALIs.Table (F).Last_Specific_Dispatching
               loop
                  declare
                     DTK : Specific_Dispatching_Record
                             renames Specific_Dispatching.Table (K);
                  begin
                     --  Check whether pragma Task_Dispatching_Policy and
                     --  pragma Priority_Specific_Dispatching are used in the
                     --  same partition.

                     if Task_Dispatching_Policy_Specified /= ' ' then
                        Error_Msg_File_1 := ALIs.Table (F).Sfile;
                        Error_Msg_File_2 :=
                          ALIs.Table (TDP_Pragma_Afile).Sfile;

                        Error_Msg_Nat_1 := DTK.PSD_Pragma_Line;

                        Consistency_Error_Msg
                          ("Priority_Specific_Dispatching at {:#" &
                           " incompatible with Task_Dispatching_Policy at {");
                     end if;

                     --  Ceiling_Locking must also be specified for a partition
                     --  with at least one Priority_Specific_Dispatching
                     --  pragma.

                     if Locking_Policy_Specified /= ' '
                       and then Locking_Policy_Specified /= 'C'
                     then
                        for A in ALIs.First .. ALIs.Last loop
                           if ALIs.Table (A).Locking_Policy /= ' '
                             and then ALIs.Table (A).Locking_Policy /= 'C'
                           then
                              Error_Msg_File_1 := ALIs.Table (F).Sfile;
                              Error_Msg_File_2 := ALIs.Table (A).Sfile;

                              Error_Msg_Nat_1  := DTK.PSD_Pragma_Line;

                              Consistency_Error_Msg
                                ("Priority_Specific_Dispatching at {:#" &
                                 " incompatible with Locking_Policy at {");
                           end if;
                        end loop;
                     end if;

                     --  Check overlapping priority ranges

                     Find_Overlapping : for Prio in
                       DTK.First_Priority .. DTK.Last_Priority
                     loop
                        if PSD_Table (Prio).Afile = No_ALI_Id then
                           PSD_Table (Prio) :=
                             (Dispatching_Policy => DTK.Dispatching_Policy,
                              Afile => F, Loc => DTK.PSD_Pragma_Line);

                        elsif PSD_Table (Prio).Dispatching_Policy /=
                              DTK.Dispatching_Policy

                        then
                           Error_Msg_File_1 :=
                             ALIs.Table (PSD_Table (Prio).Afile).Sfile;
                           Error_Msg_File_2 := ALIs.Table (F).Sfile;
                           Error_Msg_Nat_1  := PSD_Table (Prio).Loc;
                           Error_Msg_Nat_2  := DTK.PSD_Pragma_Line;

                           Consistency_Error_Msg
                             ("overlapping priority ranges at {:# and {:#");

                           exit Find_Overlapping;
                        end if;
                     end loop Find_Overlapping;
                  end;
               end loop;
            end loop;
         end;
      end if;
   end Check_Consistent_Dispatching_Policy;

   ---------------------------------------------------
   -- Check_Consistent_Dynamic_Elaboration_Checking --
   ---------------------------------------------------

   --  The rule here is that if a unit has dynamic elaboration checks,
   --  then any unit it withs must meeting one of the following criteria:

   --    1. There is a pragma Elaborate_All for the with'ed unit
   --    2. The with'ed unit was compiled with dynamic elaboration checks
   --    3. The with'ed unit has pragma Preelaborate or Pure
   --    4. It is an internal GNAT unit (including children of GNAT)

   procedure Check_Consistent_Dynamic_Elaboration_Checking is
   begin
      if Dynamic_Elaboration_Checks_Specified then
         for U in First_Unit_Entry .. Units.Last loop
            declare
               UR : Unit_Record renames Units.Table (U);

            begin
               if UR.Dynamic_Elab then
                  for W in UR.First_With .. UR.Last_With loop
                     declare
                        WR : With_Record renames Withs.Table (W);

                     begin
                        if Get_Name_Table_Info (WR.Uname) /= 0 then
                           declare
                              WU : Unit_Record renames
                                     Units.Table
                                       (Unit_Id
                                         (Get_Name_Table_Info (WR.Uname)));

                           begin
                              --  Case 1. Elaborate_All for with'ed unit

                              if WR.Elaborate_All then
                                 null;

                              --  Case 2. With'ed unit has dynamic elab checks

                              elsif WU.Dynamic_Elab then
                                 null;

                              --  Case 3. With'ed unit is Preelaborate or Pure

                              elsif WU.Preelab or else WU.Pure then
                                 null;

                              --  Case 4. With'ed unit is internal file

                              elsif Is_Internal_File_Name (WU.Sfile) then
                                 null;

                              --  Issue warning, not one of the safe cases

                              else
                                 Error_Msg_File_1 := UR.Sfile;
                                 Error_Msg
                                   ("?{ has dynamic elaboration checks " &
                                                                 "and with's");

                                 Error_Msg_File_1 := WU.Sfile;
                                 Error_Msg
                                   ("?  { which has static elaboration " &
                                                                     "checks");

                                 Warnings_Detected := Warnings_Detected - 1;
                              end if;
                           end;
                        end if;
                     end;
                  end loop;
               end if;
            end;
         end loop;
      end if;
   end Check_Consistent_Dynamic_Elaboration_Checking;

   --------------------------------------------
   -- Check_Consistent_Floating_Point_Format --
   --------------------------------------------

   --  The rule is that all files must be compiled with the same setting
   --  for the floating-point format.

   procedure Check_Consistent_Floating_Point_Format is
   begin
      --  First search for a unit specifying a floating-point format and then
      --  check all remaining units against it.

      Find_Format : for A1 in ALIs.First .. ALIs.Last loop
         if ALIs.Table (A1).Float_Format /= ' ' then
            Check_Format : declare
               Format : constant Character := ALIs.Table (A1).Float_Format;
            begin
               for A2 in A1 + 1 .. ALIs.Last loop
                  if ALIs.Table (A2).Float_Format /= Format then
                     Error_Msg_File_1 := ALIs.Table (A1).Sfile;
                     Error_Msg_File_2 := ALIs.Table (A2).Sfile;

                     Consistency_Error_Msg
                       ("{ and { compiled with different " &
                        "floating-point representations");
                     exit Find_Format;
                  end if;
               end loop;
            end Check_Format;

            exit Find_Format;
         end if;
      end loop Find_Format;
   end Check_Consistent_Floating_Point_Format;

   ---------------------------------------
   -- Check_Consistent_Interrupt_States --
   ---------------------------------------

   --  The rule is that if the state of a given interrupt is specified
   --  in more than one unit, it must be specified with a consistent state.

   procedure Check_Consistent_Interrupt_States is
      Max_Intrup : Nat;

   begin
      --  If no Interrupt_State entries, nothing to do

      if Interrupt_States.Last < Interrupt_States.First then
         return;
      end if;

      --  First find out the maximum interrupt value

      Max_Intrup := 0;
      for J in Interrupt_States.First .. Interrupt_States.Last loop
         if Interrupt_States.Table (J).Interrupt_Id > Max_Intrup then
            Max_Intrup := Interrupt_States.Table (J).Interrupt_Id;
         end if;
      end loop;

      --  Now establish tables to be used for consistency checking

      declare
         Istate : array (0 .. Max_Intrup) of Character := (others => 'n');
         --  Interrupt state entries, 'u'/'s'/'r' or 'n' to indicate an
         --  entry that has not been set.

         Afile : array (0 .. Max_Intrup) of ALI_Id;
         --  ALI file that generated Istate entry for consistency message

         Loc : array (0 .. Max_Intrup) of Nat;
         --  Line numbers from IS pragma generating Istate entry

         Inum : Nat;
         --  Interrupt number from entry being tested

         Stat : Character;
         --  Interrupt state from entry being tested

         Lnum : Nat;
         --  Line number from entry being tested

      begin
         for F in ALIs.First .. ALIs.Last loop
            for K in ALIs.Table (F).First_Interrupt_State ..
                     ALIs.Table (F).Last_Interrupt_State
            loop
               Inum := Interrupt_States.Table (K).Interrupt_Id;
               Stat := Interrupt_States.Table (K).Interrupt_State;
               Lnum := Interrupt_States.Table (K).IS_Pragma_Line;

               if Istate (Inum) = 'n' then
                  Istate (Inum) := Stat;
                  Afile  (Inum) := F;
                  Loc    (Inum) := Lnum;

               elsif Istate (Inum) /= Stat then
                  Error_Msg_File_1 := ALIs.Table (Afile (Inum)).Sfile;
                  Error_Msg_File_2 := ALIs.Table (F).Sfile;
                  Error_Msg_Nat_1  := Loc (Inum);
                  Error_Msg_Nat_2  := Lnum;

                  Consistency_Error_Msg
                    ("inconsistent interrupt states at {:# and {:#");
               end if;
            end loop;
         end loop;
      end;
   end Check_Consistent_Interrupt_States;

   -------------------------------------
   -- Check_Consistent_Locking_Policy --
   -------------------------------------

   --  The rule is that all files for which the locking policy is
   --  significant must be compiled with the same setting.

   procedure Check_Consistent_Locking_Policy is
   begin
      --  First search for a unit specifying a policy and then
      --  check all remaining units against it.

      Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
         if ALIs.Table (A1).Locking_Policy /= ' ' then
            Check_Policy : declare
               Policy : constant Character := ALIs.Table (A1).Locking_Policy;

            begin
               for A2 in A1 + 1 .. ALIs.Last loop
                  if ALIs.Table (A2).Locking_Policy /= ' '
                       and then
                     ALIs.Table (A2).Locking_Policy /= Policy
                  then
                     Error_Msg_File_1 := ALIs.Table (A1).Sfile;
                     Error_Msg_File_2 := ALIs.Table (A2).Sfile;

                     Consistency_Error_Msg
                       ("{ and { compiled with different locking policies");
                     exit Find_Policy;
                  end if;
               end loop;
            end Check_Policy;

            exit Find_Policy;
         end if;
      end loop Find_Policy;
   end Check_Consistent_Locking_Policy;

   ----------------------------------------
   -- Check_Consistent_Normalize_Scalars --
   ----------------------------------------

   --  The rule is that if any unit is compiled with Normalized_Scalars,
   --  then all other units in the partition must also be compiled with
   --  Normalized_Scalars in effect.

   --  There is some issue as to whether this consistency check is desirable,
   --  it is certainly required at the moment by the RM. We should keep a watch
   --  on the ARG and HRG deliberations here. GNAT no longer depends on this
   --  consistency (it used to do so, but that is no longer the case, since
   --  pragma Initialize_Scalars pragma does not require consistency.)

   procedure Check_Consistent_Normalize_Scalars is
   begin
      if Normalize_Scalars_Specified and No_Normalize_Scalars_Specified then
         Consistency_Error_Msg
              ("some but not all files compiled with Normalize_Scalars");

         Write_Eol;
         Write_Str ("files compiled with Normalize_Scalars");
         Write_Eol;

         for A1 in ALIs.First .. ALIs.Last loop
            if ALIs.Table (A1).Normalize_Scalars then
               Write_Str ("  ");
               Write_Name (ALIs.Table (A1).Sfile);
               Write_Eol;
            end if;
         end loop;

         Write_Eol;
         Write_Str ("files compiled without Normalize_Scalars");
         Write_Eol;

         for A1 in ALIs.First .. ALIs.Last loop
            if not ALIs.Table (A1).Normalize_Scalars then
               Write_Str ("  ");
               Write_Name (ALIs.Table (A1).Sfile);
               Write_Eol;
            end if;
         end loop;
      end if;
   end Check_Consistent_Normalize_Scalars;

   -----------------------------------------
   -- Check_Consistent_Optimize_Alignment --
   -----------------------------------------

   --  The rule is that all units which depend on the global default setting
   --  of Optimize_Alignment must be compiled with the same setting for this
   --  default. Units which specify an explicit local value for this setting
   --  are exempt from the consistency rule (this includes all internal units).

   procedure Check_Consistent_Optimize_Alignment is
      OA_Setting : Character := ' ';
      --  Reset when we find a unit that depends on the default and does
      --  not have a local specification of the Optimize_Alignment setting.

      OA_Unit : Unit_Id;
      --  Id of unit from which OA_Setting was set

      C : Character;

   begin
      for U in First_Unit_Entry .. Units.Last loop
         C := Units.Table (U).Optimize_Alignment;

         if C /= 'L' then
            if OA_Setting = ' ' then
               OA_Setting := C;
               OA_Unit := U;

            elsif OA_Setting = C then
               null;

            else
               Error_Msg_Unit_1 := Units.Table (OA_Unit).Uname;
               Error_Msg_Unit_2 := Units.Table (U).Uname;

               Consistency_Error_Msg
                 ("$ and $ compiled with different "
                  & "default Optimize_Alignment settings");
               return;
            end if;
         end if;
      end loop;
   end Check_Consistent_Optimize_Alignment;

   ---------------------------------------------------
   -- Check_Consistent_Partition_Elaboration_Policy --
   ---------------------------------------------------

   --  The rule is that all files for which the partition elaboration policy is
   --  significant must be compiled with the same setting.

   procedure Check_Consistent_Partition_Elaboration_Policy is
   begin
      --  First search for a unit specifying a policy and then
      --  check all remaining units against it.

      Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
         if ALIs.Table (A1).Partition_Elaboration_Policy /= ' ' then
            Check_Policy : declare
               Policy : constant Character :=
                  ALIs.Table (A1).Partition_Elaboration_Policy;

            begin
               for A2 in A1 + 1 .. ALIs.Last loop
                  if ALIs.Table (A2).Partition_Elaboration_Policy /= ' '
                       and then
                     ALIs.Table (A2).Partition_Elaboration_Policy /= Policy
                  then
                     Error_Msg_File_1 := ALIs.Table (A1).Sfile;
                     Error_Msg_File_2 := ALIs.Table (A2).Sfile;

                     Consistency_Error_Msg
                       ("{ and { compiled with different partition "
                          & "elaboration policies");
                     exit Find_Policy;
                  end if;
               end loop;
            end Check_Policy;

            --  A No_Task_Hierarchy restriction must be specified for the
            --  Sequential policy (RM H.6(6/2)).

            if Partition_Elaboration_Policy_Specified = 'S'
              and then not Cumulative_Restrictions.Set (No_Task_Hierarchy)
            then
               Error_Msg_File_1 := ALIs.Table (A1).Sfile;
               Error_Msg
                 ("{ has sequential partition elaboration policy, but no");
               Error_Msg
                 ("pragma Restrictions (No_Task_Hierarchy) was specified");
            end if;

            exit Find_Policy;
         end if;
      end loop Find_Policy;
   end Check_Consistent_Partition_Elaboration_Policy;

   -------------------------------------
   -- Check_Consistent_Queuing_Policy --
   -------------------------------------

   --  The rule is that all files for which the queuing policy is
   --  significant must be compiled with the same setting.

   procedure Check_Consistent_Queuing_Policy is
   begin
      --  First search for a unit specifying a policy and then
      --  check all remaining units against it.

      Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
         if ALIs.Table (A1).Queuing_Policy /= ' ' then
            Check_Policy : declare
               Policy : constant Character := ALIs.Table (A1).Queuing_Policy;
            begin
               for A2 in A1 + 1 .. ALIs.Last loop
                  if ALIs.Table (A2).Queuing_Policy /= ' '
                       and then
                     ALIs.Table (A2).Queuing_Policy /= Policy
                  then
                     Error_Msg_File_1 := ALIs.Table (A1).Sfile;
                     Error_Msg_File_2 := ALIs.Table (A2).Sfile;

                     Consistency_Error_Msg
                       ("{ and { compiled with different queuing policies");
                     exit Find_Policy;
                  end if;
               end loop;
            end Check_Policy;

            exit Find_Policy;
         end if;
      end loop Find_Policy;
   end Check_Consistent_Queuing_Policy;

   -----------------------------------
   -- Check_Consistent_Restrictions --
   -----------------------------------

   --  The rule is that if a restriction is specified in any unit, then all
   --  units must obey the restriction. The check applies only to restrictions
   --  which require partition wide consistency, and not to internal units.

   procedure Check_Consistent_Restrictions is
      Restriction_File_Output : Boolean;
      --  Shows if we have output header messages for restriction violation

      procedure Print_Restriction_File (R : All_Restrictions);
      --  Print header line for R if not printed yet

      ----------------------------
      -- Print_Restriction_File --
      ----------------------------

      procedure Print_Restriction_File (R : All_Restrictions) is
      begin
         if not Restriction_File_Output then
            Restriction_File_Output := True;

            --  Find an ali file specifying the restriction

            for A in ALIs.First .. ALIs.Last loop
               if ALIs.Table (A).Restrictions.Set (R)
                 and then (R in All_Boolean_Restrictions
                             or else ALIs.Table (A).Restrictions.Value (R) =
                                     Cumulative_Restrictions.Value (R))
               then
                  --  We have found that ALI file A specifies the restriction
                  --  that is being violated (the minimum value is specified
                  --  in the case of a parameter restriction).

                  declare
                     M1 : constant String := "{ has restriction ";
                     S  : constant String := Restriction_Id'Image (R);
                     M2 : String (1 .. 2000); -- big enough!
                     P  : Integer;

                  begin
                     Name_Buffer (1 .. S'Length) := S;
                     Name_Len := S'Length;
                     Set_Casing (Mixed_Case);

                     M2 (M1'Range) := M1;
                     P := M1'Length + 1;
                     M2 (P .. P + S'Length - 1) := Name_Buffer (1 .. S'Length);
                     P := P + S'Length;

                     if R in All_Parameter_Restrictions then
                        M2 (P .. P + 4) := " => #";
                        Error_Msg_Nat_1 :=
                          Int (Cumulative_Restrictions.Value (R));
                        P := P + 5;
                     end if;

                     Error_Msg_File_1 := ALIs.Table (A).Sfile;
                     Consistency_Error_Msg (M2 (1 .. P - 1));
                     Consistency_Error_Msg
                       ("but the following files violate this restriction:");
                     return;
                  end;
               end if;
            end loop;
         end if;
      end Print_Restriction_File;

   --  Start of processing for Check_Consistent_Restrictions

   begin
      --  A special test, if we have a main program, then if it has an
      --  allocator in the body, this is considered to be a violation of
      --  the restriction No_Allocators_After_Elaboration. We just mark
      --  this restriction and then the normal circuit will flag it.

      if Bind_Main_Program
        and then ALIs.Table (ALIs.First).Main_Program /= None
        and then not No_Main_Subprogram
        and then ALIs.Table (ALIs.First).Allocator_In_Body
      then
         Cumulative_Restrictions.Violated
           (No_Standard_Allocators_After_Elaboration) := True;
         ALIs.Table (ALIs.First).Restrictions.Violated
           (No_Standard_Allocators_After_Elaboration) := True;
      end if;

      --  Loop through all restriction violations

      for R in All_Restrictions loop

         --  Check for violation of this restriction

         if Cumulative_Restrictions.Set (R)
           and then Cumulative_Restrictions.Violated (R)
           and then (R in Partition_Boolean_Restrictions
                       or else (R in All_Parameter_Restrictions
                                   and then
                                     Cumulative_Restrictions.Count (R) >
                                     Cumulative_Restrictions.Value (R)))
         then
            Restriction_File_Output := False;

            --  Loop through files looking for violators

            for A2 in ALIs.First .. ALIs.Last loop
               declare
                  T : ALIs_Record renames ALIs.Table (A2);

               begin
                  if T.Restrictions.Violated (R) then

                     --  We exclude predefined files from the list of
                     --  violators. This should be rethought. It is not
                     --  clear that this is the right thing to do, that
                     --  is particularly the case for restricted runtimes.

                     if not Is_Internal_File_Name (T.Sfile) then

                        --  Case of Boolean restriction, just print file name

                        if R in All_Boolean_Restrictions then
                           Print_Restriction_File (R);
                           Error_Msg_File_1 := T.Sfile;
                           Consistency_Error_Msg ("  {");

                        --  Case of Parameter restriction where violation
                        --  count exceeds restriction value, print file
                        --  name and count, adding "at least" if the
                        --  exact count is not known.

                        elsif R in Checked_Add_Parameter_Restrictions
                          or else T.Restrictions.Count (R) >
                          Cumulative_Restrictions.Value (R)
                        then
                           Print_Restriction_File (R);
                           Error_Msg_File_1 := T.Sfile;
                           Error_Msg_Nat_1 := Int (T.Restrictions.Count (R));

                           if T.Restrictions.Unknown (R) then
                              Consistency_Error_Msg
                                ("  { (count = at least #)");
                           else
                              Consistency_Error_Msg
                                ("  { (count = #)");
                           end if;
                        end if;
                     end if;
                  end if;
               end;
            end loop;
         end if;
      end loop;

      --  Now deal with No_Dependence indications. Note that we put the loop
      --  through entries in the no dependency table first, since this loop
      --  is most often empty (no such pragma Restrictions in use).

      for ND in No_Deps.First .. No_Deps.Last loop
         declare
            ND_Unit : constant Name_Id := No_Deps.Table (ND).No_Dep_Unit;
         begin
            for J in ALIs.First .. ALIs.Last loop
               declare
                  A : ALIs_Record renames ALIs.Table (J);

               begin
                  for K in A.First_Unit .. A.Last_Unit loop
                     declare
                        U : Unit_Record renames Units.Table (K);
                     begin
                        for L in U.First_With .. U.Last_With loop
                           if Same_Unit
                             (Withs.Table (L).Uname, ND_Unit)
                           then
                              Error_Msg_File_1 := U.Sfile;
                              Error_Msg_Name_1 := ND_Unit;
                              Consistency_Error_Msg
                                ("file { violates restriction " &
                                 "No_Dependence => %");
                           end if;
                        end loop;
                     end;
                  end loop;
               end;
            end loop;
         end;
      end loop;
   end Check_Consistent_Restrictions;

   ------------------------------------------------------------
   -- Check_Consistent_Restriction_No_Default_Initialization --
   ------------------------------------------------------------

   --  The Restriction (No_Default_Initialization) has special consistency
   --  rules. The rule is that no unit compiled without this restriction
   --  that violates the restriction can WITH a unit that is compiled with
   --  the restriction.

   procedure Check_Consistent_Restriction_No_Default_Initialization is
   begin
      --  Nothing to do if no one set this restriction

      if not Cumulative_Restrictions.Set (No_Default_Initialization) then
         return;
      end if;

      --  Nothing to do if no one violates the restriction

      if not Cumulative_Restrictions.Violated (No_Default_Initialization) then
         return;
      end if;

      --  Otherwise we go into a full scan to find possible problems

      for U in Units.First .. Units.Last loop
         declare
            UTE : Unit_Record renames Units.Table (U);
            ATE : ALIs_Record renames ALIs.Table (UTE.My_ALI);

         begin
            if ATE.Restrictions.Violated (No_Default_Initialization) then
               for W in UTE.First_With .. UTE.Last_With loop
                  declare
                     AFN : constant File_Name_Type := Withs.Table (W).Afile;

                  begin
                     --  The file name may not be present for withs of certain
                     --  generic run-time files. The test can be safely left
                     --  out in such cases anyway.

                     if AFN /= No_File then
                        declare
                           WAI : constant ALI_Id :=
                             ALI_Id (Get_Name_Table_Info (AFN));
                           WTE : ALIs_Record renames ALIs.Table (WAI);

                        begin
                           if WTE.Restrictions.Set
                               (No_Default_Initialization)
                           then
                              Error_Msg_Unit_1 := UTE.Uname;
                              Consistency_Error_Msg
                                ("unit $ compiled without restriction "
                                 & "No_Default_Initialization");
                              Error_Msg_Unit_1 := Withs.Table (W).Uname;
                              Consistency_Error_Msg
                                ("withs unit $, compiled with restriction "
                                 & "No_Default_Initialization");
                           end if;
                        end;
                     end if;
                  end;
               end loop;
            end if;
         end;
      end loop;
   end Check_Consistent_Restriction_No_Default_Initialization;

   ---------------------------------------------------
   -- Check_Consistent_Zero_Cost_Exception_Handling --
   ---------------------------------------------------

   --  Check consistent zero cost exception handling. The rule is that
   --  all units must have the same exception handling mechanism.

   procedure Check_Consistent_Zero_Cost_Exception_Handling is
   begin
      Check_Mechanism : for A1 in ALIs.First + 1 .. ALIs.Last loop
         if ALIs.Table (A1).Zero_Cost_Exceptions /=
            ALIs.Table (ALIs.First).Zero_Cost_Exceptions
         then
            Error_Msg_File_1 := ALIs.Table (A1).Sfile;
            Error_Msg_File_2 := ALIs.Table (ALIs.First).Sfile;

            Consistency_Error_Msg ("{ and { compiled with different "
                                            & "exception handling mechanisms");
         end if;
      end loop Check_Mechanism;
   end Check_Consistent_Zero_Cost_Exception_Handling;

   -------------------------------
   -- Check_Duplicated_Subunits --
   -------------------------------

   procedure Check_Duplicated_Subunits is
   begin
      for J in Sdep.First .. Sdep.Last loop
         if Sdep.Table (J).Subunit_Name /= No_Name then
            Get_Decoded_Name_String (Sdep.Table (J).Subunit_Name);
            Name_Len := Name_Len + 2;
            Name_Buffer (Name_Len - 1) := '%';

            --  See if there is a body or spec with the same name

            for K in Boolean loop
               if K then
                  Name_Buffer (Name_Len) := 'b';
               else
                  Name_Buffer (Name_Len) := 's';
               end if;

               declare
                  Unit : constant Unit_Name_Type := Name_Find;
                  Info : constant Int := Get_Name_Table_Info (Unit);

               begin
                  if Info /= 0 then
                     Set_Standard_Error;
                     Write_Str ("error: subunit """);
                     Write_Name_Decoded (Sdep.Table (J).Subunit_Name);
                     Write_Str (""" in file """);
                     Write_Name_Decoded (Sdep.Table (J).Sfile);
                     Write_Char ('"');
                     Write_Eol;
                     Write_Str ("       has same name as unit """);
                     Write_Unit_Name (Units.Table (Unit_Id (Info)).Uname);
                     Write_Str (""" found in file """);
                     Write_Name_Decoded (Units.Table (Unit_Id (Info)).Sfile);
                     Write_Char ('"');
                     Write_Eol;
                     Write_Str ("       this is not allowed within a single "
                                & "partition (RM 10.2(19))");
                     Write_Eol;
                     Osint.Exit_Program (Osint.E_Fatal);
                  end if;
               end;
            end loop;
         end if;
      end loop;
   end Check_Duplicated_Subunits;

   --------------------
   -- Check_Versions --
   --------------------

   procedure Check_Versions is
      VL : constant Natural := ALIs.Table (ALIs.First).Ver_Len;

   begin
      for A in ALIs.First .. ALIs.Last loop
         if ALIs.Table (A).Ver_Len /= VL
           or else ALIs.Table (A).Ver          (1 .. VL) /=
                   ALIs.Table (ALIs.First).Ver (1 .. VL)
         then
            Error_Msg_File_1 := ALIs.Table (A).Sfile;
            Error_Msg_File_2 := ALIs.Table (ALIs.First).Sfile;

            Consistency_Error_Msg
               ("{ and { compiled with different GNAT versions");
         end if;
      end loop;
   end Check_Versions;

   ---------------------------
   -- Consistency_Error_Msg --
   ---------------------------

   procedure Consistency_Error_Msg (Msg : String) is
   begin
      if Tolerate_Consistency_Errors then

         --  If consistency errors are tolerated,
         --  output the message as a warning.

         Error_Msg ('?' & Msg);

      --  Otherwise the consistency error is a true error

      else
         Error_Msg (Msg);
      end if;
   end Consistency_Error_Msg;

   ---------------
   -- Same_Unit --
   ---------------

   function Same_Unit (U1 : Unit_Name_Type; U2 : Name_Id) return Boolean is
   begin
      --  Note, the string U1 has a terminating %s or %b, U2 does not

      if Length_Of_Name (U1) - 2 = Length_Of_Name (U2) then
         Get_Name_String (U1);

         declare
            U1_Str : constant String := Name_Buffer (1 .. Name_Len - 2);
         begin
            Get_Name_String (U2);
            return U1_Str = Name_Buffer (1 .. Name_Len);
         end;

      else
         return False;
      end if;
   end Same_Unit;

end Bcheck;