OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gcc-4.5.1/] [gcc/] [testsuite/] [lib/] [target-supports-dg.exp] - Blame information for rev 816

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 306 jeremybenn
#   Copyright (C) 1997, 1999, 2000, 2003, 2004, 2005, 2007, 2008, 2009, 2010
2
#   Free Software Foundation, Inc.
3
 
4
# This program is free software; you can redistribute it and/or modify
5
# it under the terms of the GNU General Public License as published by
6
# the Free Software Foundation; either version 3 of the License, or
7
# (at your option) any later version.
8
#
9
# This program is distributed in the hope that it will be useful,
10
# but WITHOUT ANY WARRANTY; without even the implied warranty of
11
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12
# GNU General Public License for more details.
13
#
14
# You should have received a copy of the GNU General Public License
15
# along with GCC; see the file COPYING3.  If not see
16
# .
17
 
18
# DejaGnu's dg-test defines extra flags that are used to compile a test.
19
# Access them for directives that need to examine all options that are
20
# used for a test, including checks for non-cached effective targets.
21
# We don't know how far up the call chain it is but we know we'll hit
22
# it eventually, and that we're at least 3 calls down.
23
 
24
proc current_compiler_flags { } {
25
    set frames 2
26
    while { ![info exists flags1] } {
27
        set frames [expr $frames + 1]
28
        upvar $frames dg-extra-tool-flags flags1
29
    }
30
    upvar $frames tool_flags flags2
31
    return "$flags1 $flags2"
32
}
33
 
34
# If this target does not support weak symbols, skip this test.
35
 
36
proc dg-require-weak { args } {
37
    set weak_available [ check_weak_available ]
38
    if { $weak_available == -1 } {
39
        upvar name name
40
        unresolved "$name"
41
    }
42
    if { $weak_available != 1 } {
43
        upvar dg-do-what dg-do-what
44
        set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
45
    }
46
}
47
 
48
# If this target does not support overriding weak symbols, skip this
49
# test.
50
 
51
proc dg-require-weak-override { args } {
52
    set weak_override_available [ check_weak_override_available ]
53
    if { $weak_override_available == -1 } {
54
        upvar name name
55
        unresolved "$name"
56
    }
57
    if { $weak_override_available != 1 } {
58
        upvar dg-do-what dg-do-what
59
        set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
60
    }
61
}
62
 
63
# If this target does not support the "visibility" attribute, skip this
64
# test.
65
 
66
proc dg-require-visibility { args } {
67
    set visibility_available [ check_visibility_available [lindex $args 1 ] ]
68
    if { $visibility_available == -1 } {
69
        upvar name name
70
        unresolved "$name"
71
    }
72
    if { $visibility_available != 1 } {
73
        upvar dg-do-what dg-do-what
74
        set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
75
    }
76
}
77
 
78
# If this target does not support the "alias" attribute, skip this
79
# test.
80
 
81
proc dg-require-alias { args } {
82
    set alias_available [ check_alias_available ]
83
    if { $alias_available == -1 } {
84
        upvar name name
85
        unresolved "$name"
86
    }
87
    if { $alias_available < 2 } {
88
        upvar dg-do-what dg-do-what
89
        set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
90
    }
91
}
92
 
93
# If this target's linker does not support the --gc-sections flag,
94
# skip this test.
95
 
96
proc dg-require-gc-sections { args } {
97
    if { ![ check_gc_sections_available ] } {
98
        upvar dg-do-what dg-do-what
99
        set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
100
    }
101
}
102
 
103
# If this target does not support profiling, skip this test.
104
 
105
proc dg-require-profiling { args } {
106
    if { ![ check_profiling_available ${args} ] } {
107
        upvar dg-do-what dg-do-what
108
        set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
109
    }
110
}
111
 
112
# If this target does not support DLL attributes skip this test.
113
 
114
proc dg-require-dll { args } {
115
    global target_triplet
116
    # As a special case, the mcore-*-elf supports these attributes.
117
    # All Symbian OS targets also support these attributes.
118
    if { [string match "mcore-*-elf" $target_triplet]
119
         || [string match "*-*-symbianelf" $target_triplet]} {
120
        return
121
    }
122
    # PE/COFF targets support dllimport/dllexport.
123
    if { [gcc_target_object_format] == "pe" } {
124
        return
125
    }
126
 
127
    upvar dg-do-what dg-do-what
128
    set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
129
}
130
 
131
proc dg-require-iconv { args } {
132
    if { ![ check_iconv_available ${args} ] } {
133
        upvar dg-do-what dg-do-what
134
        set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
135
    }
136
}
137
 
138
# If this target does not support named sections skip this test.
139
 
140
proc dg-require-named-sections { args } {
141
    if { ![ check_named_sections_available ] } {
142
        upvar dg-do-what dg-do-what
143
        set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
144
    }
145
}
146
 
147
# If the target does not match the required effective target, skip this test.
148
# Only apply this if the optional selector matches.
149
 
150
proc dg-require-effective-target { args } {
151
    set args [lreplace $args 0 0]
152
    # Verify the number of arguments.  The last is optional.
153
    if { [llength $args] < 1 || [llength $args] > 2 } {
154
        error "syntax error, need a single effective-target keyword with optional selector"
155
    }
156
 
157
    # Evaluate selector if present.
158
    if { [llength $args] == 2 } {
159
        switch [dg-process-target [lindex $args 1]] {
160
            "S" { }
161
            "N" { return }
162
        }
163
    }
164
 
165
    if { ![is-effective-target [lindex $args 0]] } {
166
        upvar dg-do-what dg-do-what
167
        set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
168
    }
169
}
170
 
171
# If this target does not have fork, skip this test.
172
 
173
proc dg-require-fork { args } {
174
    if { ![check_fork_available] } {
175
        upvar dg-do-what dg-do-what
176
        set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
177
    }
178
}
179
 
180
# If this target does not have mkfifo, skip this test.
181
 
182
proc dg-require-mkfifo { args } {
183
    if { ![check_mkfifo_available] } {
184
        upvar dg-do-what dg-do-what
185
        set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
186
    }
187
}
188
 
189
# If this target does not use __cxa_atexit, skip this test.
190
 
191
proc dg-require-cxa-atexit { args } {
192
    if { ![ check_cxa_atexit_available ] } {
193
        upvar dg-do-what dg-do-what
194
        set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
195
    }
196
}
197
 
198
# If the host is remote rather than the same as the build system, skip
199
# this test.  Some tests are incompatible with DejaGnu's handling of
200
# remote hosts, which involves copying the source file to the host and
201
# compiling it with a relative path and "-o a.out".
202
 
203
proc dg-require-host-local { args } {
204
    if [ is_remote host ] {
205
        upvar dg-do-what dg-do-what
206
        set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
207
    }
208
}
209
 
210
# Add any target-specific flags needed for accessing the given list
211
# of features.  This must come after all dg-options.
212
 
213
proc dg-add-options { args } {
214
    upvar dg-extra-tool-flags extra-tool-flags
215
 
216
    foreach arg [lrange $args 1 end] {
217
        if { [info procs add_options_for_$arg] != "" } {
218
            set extra-tool-flags \
219
                [eval [list add_options_for_$arg ${extra-tool-flags}]]
220
        } else {
221
            error "Unrecognized option type: $arg"
222
        }
223
    }
224
}
225
 
226
# Compare flags for a test directive against flags that will be used to
227
# compile the test: multilib flags, flags for torture options, and either
228
# the default flags for this group of tests or flags specified with a
229
# previous dg-options directive.
230
 
231
proc check-flags { args } {
232
    global compiler_flags
233
    global TOOL_OPTIONS
234
 
235
    # The args are within another list; pull them out.
236
    set args [lindex $args 0]
237
 
238
    # Start the list with a dummy tool name so the list will match "*"
239
    # if there are no flags.
240
    set compiler_flags " toolname "
241
    append compiler_flags [current_compiler_flags]
242
    # If running a subset of the test suite, $TOOL_OPTIONS may not exist.
243
    catch {append compiler_flags " $TOOL_OPTIONS "}
244
    set dest [target_info name]
245
    if [board_info $dest exists multilib_flags] {
246
        append compiler_flags "[board_info $dest multilib_flags] "
247
    }
248
 
249
    # The next two arguments are optional.  If they were not specified,
250
    # use the defaults.
251
    if { [llength $args] == 2 } {
252
        lappend $args [list "*"]
253
    }
254
    if { [llength $args] == 3 } {
255
        lappend $args [list ""]
256
    }
257
 
258
    # If the option strings are the defaults, or the same as the
259
    # defaults, there is no need to call check_conditional_xfail to
260
    # compare them to the actual options.
261
    if { [string compare [lindex $args 2] "*"] == 0
262
         && [string compare [lindex $args 3] "" ] == 0 } {
263
        set result 1
264
    } else {
265
        # The target list might be an effective-target keyword, so replace
266
        # the original list with "*-*-*", since we already know it matches.
267
        set result [check_conditional_xfail [lreplace $args 1 1 "*-*-*"]]
268
    }
269
 
270
    # Any value in this variable was left over from an earlier test.
271
    set compiler_flags ""
272
 
273
    return $result
274
}
275
 
276
# Skip the test (report it as UNSUPPORTED) if the target list and
277
# included flags are matched and the excluded flags are not matched.
278
#
279
# The first argument is the line number of the dg-skip-if directive
280
# within the test file.   Remaining arguments are as for xfail lists:
281
# message { targets } { include } { exclude }
282
#
283
# This tests against multilib flags plus either the default flags for this
284
# group of tests or flags specified with a previous dg-options command.
285
 
286
proc dg-skip-if { args } {
287
    # Verify the number of arguments.  The last two are optional.
288
    set args [lreplace $args 0 0]
289
    if { [llength $args] < 2 || [llength $args] > 4 } {
290
        error "dg-skip-if 2: need 2, 3, or 4 arguments"
291
    }
292
 
293
    # Don't bother if we're already skipping the test.
294
    upvar dg-do-what dg-do-what
295
    if { [lindex ${dg-do-what} 1] == "N" } {
296
      return
297
    }
298
 
299
    set selector [list target [lindex $args 1]]
300
    if { [dg-process-target $selector] == "S" } {
301
        if [check-flags $args] {
302
            upvar dg-do-what dg-do-what
303
            set dg-do-what [list [lindex ${dg-do-what} 0] "N" "P"]
304
        }
305
    }
306
}
307
 
308
# Like check_conditional_xfail, but callable from a dg test.
309
 
310
proc dg-xfail-if { args } {
311
    # Verify the number of arguments.  The last three are optional.
312
    set args [lreplace $args 0 0]
313
    if { [llength $args] < 2 || [llength $args] > 4 } {
314
        error "dg-xfail-if: need 2, 3, or 4 arguments"
315
    }
316
 
317
    # Don't change anything if we're already skipping the test.
318
    upvar dg-do-what dg-do-what
319
    if { [lindex ${dg-do-what} 1] == "N" } {
320
      return
321
    }
322
 
323
    set selector [list target [lindex $args 1]]
324
    if { [dg-process-target $selector] == "S" } {
325
        global compiler_conditional_xfail_data
326
 
327
        # The target list might be an effective-target keyword.  Replace
328
        # the original list with "*-*-*", since we already know it matches.
329
        set args [lreplace $args 1 1 "*-*-*"]
330
 
331
        # Supply default values for unspecified optional arguments.
332
        if { [llength $args] == 2 } {
333
            lappend $args [list "*"]
334
        }
335
        if { [llength $args] == 3 } {
336
            lappend $args [list ""]
337
        }
338
 
339
        set compiler_conditional_xfail_data $args
340
    }
341
}
342
 
343
# Like dg-xfail-if but for the execute step.
344
 
345
proc dg-xfail-run-if { args } {
346
    # Verify the number of arguments.  The last two are optional.
347
    set args [lreplace $args 0 0]
348
    if { [llength $args] < 2 || [llength $args] > 4 } {
349
        error "dg-xfail-run-if: need 2, 3, or 4 arguments"
350
    }
351
 
352
    # Don't bother if we're already skipping the test.
353
    upvar dg-do-what dg-do-what
354
    if { [lindex ${dg-do-what} 1] == "N" } {
355
      return
356
    }
357
 
358
    set selector [list target [lindex $args 1]]
359
    if { [dg-process-target $selector] == "S" } {
360
        if [check-flags $args] {
361
            upvar dg-do-what dg-do-what
362
            set dg-do-what [list [lindex ${dg-do-what} 0] "S" "F"]
363
        }
364
    }
365
}
366
 
367
# Record whether the program is expected to return a nonzero status.
368
 
369
set shouldfail 0
370
 
371
proc dg-shouldfail { args } {
372
    # Don't bother if we're already skipping the test.
373
    upvar dg-do-what dg-do-what
374
    if { [lindex ${dg-do-what} 1] == "N" } {
375
      return
376
    }
377
 
378
    global shouldfail
379
 
380
    set args [lreplace $args 0 0]
381
    if { [llength $args] > 1 } {
382
        set selector [list target [lindex $args 1]]
383
        if { [dg-process-target $selector] == "S" } {
384
            # The target matches, now check the flags.
385
            if [check-flags $args] {
386
                set shouldfail 1
387
            }
388
        }
389
    } else {
390
        set shouldfail 1
391
    }
392
}
393
 
394
# Intercept the call to the DejaGnu version of dg-process-target to
395
# support use of an effective-target keyword in place of a list of
396
# target triplets to xfail or skip a test.
397
#
398
# selector is one of:
399
#    xfail target-triplet-1 ...
400
#    xfail effective-target-keyword
401
#    xfail selector-expression
402
#    target target-triplet-1 ...
403
#    target effective-target-keyword
404
#    target selector-expression
405
#
406
# For a target list the result is "S" if the target is selected, "N" otherwise.
407
# For an xfail list the result is "F" if the target is affected, "P" otherwise.
408
#
409
# A selector expression appears within curly braces and uses a single logical
410
# operator: !, &&, or ||.  An operand is another selector expression, an
411
# effective-target keyword, or a list of target triplets within quotes or
412
# curly braces.
413
 
414
if { [info procs saved-dg-process-target] == [list] } {
415
    rename dg-process-target saved-dg-process-target
416
 
417
    # Evaluate an operand within a selector expression.
418
    proc selector_opd { op } {
419
        set selector "target"
420
        lappend selector $op
421
        set answer [ expr { [dg-process-target $selector] == "S" } ]
422
        verbose "selector_opd: `$op' $answer" 2
423
        return $answer
424
    }
425
 
426
    # Evaluate a target triplet list within a selector expression.
427
    # Unlike other operands, this needs to be expanded from a list to
428
    # the same string as "target".
429
    proc selector_list { op } {
430
        set selector "target [join $op]"
431
        set answer [ expr { [dg-process-target $selector] == "S" } ]
432
        verbose "selector_list: `$op' $answer" 2
433
        return $answer
434
    }
435
 
436
    # Evaluate a selector expression.
437
    proc selector_expression { exp } {
438
        if { [llength $exp] == 2 } {
439
            if [string match "!" [lindex $exp 0]] {
440
                set op1 [lindex $exp 1]
441
                set answer [expr { ! [selector_opd $op1] }]
442
            } else {
443
                # Assume it's a list of target triplets.
444
                set answer [selector_list $exp]
445
            }
446
        } elseif { [llength $exp] == 3 } {
447
            set op1 [lindex $exp 0]
448
            set opr [lindex $exp 1]
449
            set op2 [lindex $exp 2]
450
            if [string match "&&" $opr] {
451
                set answer [expr { [selector_opd $op1] && [selector_opd $op2] }]
452
            } elseif [string match "||" $opr] {
453
                set answer [expr { [selector_opd $op1] || [selector_opd $op2] }]
454
            } else {
455
                # Assume it's a list of target triplets.
456
                set answer [selector_list $exp]
457
            }
458
        } else {
459
            # Assume it's a list of target triplets.
460
            set answer [selector_list $exp]
461
        }
462
 
463
        verbose "selector_expression: `$exp' $answer" 2
464
        return $answer
465
    }
466
 
467
    proc dg-process-target { args } {
468
        verbose "replacement dg-process-target: `$args'" 2
469
 
470
        # Extract the 'what' keyword from the argument list.
471
        set selector [string trim [lindex $args 0]]
472
        if [regexp "^xfail " $selector] {
473
            set what "xfail"
474
        } elseif [regexp "^target " $selector] {
475
            set what "target"
476
        } else {
477
            error "syntax error in target selector \"$selector\""
478
        }
479
 
480
        # Extract the rest of the list, which might be a keyword.
481
        regsub "^${what}" $selector "" rest
482
        set rest [string trim $rest]
483
 
484
        if [is-effective-target-keyword $rest] {
485
            # The selector is an effective target keyword.
486
            if [is-effective-target $rest] {
487
                return [expr { $what == "xfail" ? "F" : "S" }]
488
            } else {
489
                return [expr { $what == "xfail" ? "P" : "N" }]
490
            }
491
        }
492
 
493
        if [string match "{*}" $rest] {
494
            if [selector_expression [lindex $rest 0]] {
495
                return [expr { $what == "xfail" ? "F" : "S" }]
496
            } else {
497
                return [expr { $what == "xfail" ? "P" : "N" }]
498
            }
499
        }
500
 
501
        # The selector is not an effective-target keyword, so process
502
        # the list of target triplets.
503
        return [saved-dg-process-target $selector]
504
    }
505
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.